Sub SaveFolder() Dim FSO As New FileSystemObject Dim Folder As Folder Dim File As File Set Folder = FSO.GetFolder("C:\\MyDocs\\") For Each File In Folder.Files If InStr(1, File.Name, ".wps") Then _ Call FileSaveAs(Folder.Path & "\\", File.Name, ".wps") Next End Sub

Sub FileSaveAs(DirName As String, FileName As String, Extension As String)

ChangeFileOpenDirectory DirName

Documents.Open _
    FileName:="""" & FileName & """", _
    ConfirmConversions:=False, _
    ReadOnly:=False, _
    AddToRecentFiles:=False, _
    PasswordDocument:="", _
    PasswordTemplate:="", _
    Revert:=False, _
    WritePasswordDocument:="", _
    WritePasswordTemplate:="", _
    Format:=wdOpenFormatAuto

'The ActiveDocument.SaveAs() method is hard-coded to format 112.
'Use the Application.FileConverters.Item("<Index>").SaveFormat property
'for other file formats and a more generic design.
'
ActiveDocument.SaveAs _
    FileName:=DirName & Replace(FileName, Extension, ".doc"), _
    FileFormat:=112, _
    LockComments:=False, _
    Password:="", _
    AddToRecentFiles:= _
    True, WritePassword:="", _
    ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, _
    SaveNativePictureFormat:=False, _
    SaveFormsData:=False, _
    SaveAsAOCELetter:=False

ActiveDocument.Close

End Sub