Microsoft Office Forums - View Single Post - [Solved] I need to edit a macro to open *.Doc and *.Docx files

macropod · 09-09-2022, 06:37 AM

You should not be using Word documents for this - at all. You should be using Word templates. To achieve that, all you need do is open each of those documents and save it as a dotx template if it has no macros, or as a .dotm template otherwise. That way, there's never a risk of the template file being overwritten, even if someone uses it to create a document without also using the macro.

Then, instead of:

Code:

Documents.Open FileName:="Z:\Travellers" & File & ".doc", _
            ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _
            Revert:=False, Format:=wdOpenFormatAuto, XMLTransform:=""

You'd use:

Code:

Documents.Add FileName:="Z:\Travellers" & File & ".dotx"

or, if the template has macros:

Code:

Documents.Add FileName:="Z:\Travellers" & File & ".dotm"

Converting all those documents to dotx/dotm templates is also quite straightforward:

Code:

Sub CnvtDocsToTmplts()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
Do While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      If .HasVBProject = True Then
        .SaveAs2 FileName:=Split(.FullName, ".doc")(0) & ".dotm", FileFormat:=wdFormatXMLTemplateMacroEnabled, AddToRecentFiles:=False
      Else
        .SaveAs2 FileName:=Split(.FullName, ".doc")(0) & ".dotx", FileFormat:=wdFormatXMLTemplate, AddToRecentFiles:=False
      End If
      .Close SaveChanges:=False
    End With
    Kill strFolder & "\" & strFile
  End If
  strFile = Dir()
Loop
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

With the above code, all Word documents in the selected folder will be replaced by Word dotx/dotm templates with the same names.