在Word文档上为目录和子目录VBA设置Normal.dotm模板

Question

我正在尝试删除分布在大目录和子目录中的大量 Word 文档上的模板链接。到目前为止，我已经能够删除单个文档或目录上的模板，但不能删除子目录上的模板。我一直在尝试利用 Graham Mayor 的批处理实用程序 https://www.gmayor.com/document_batch_processes.htm 但无济于事。不会报告任何错误，并且测试目录中的所有文件都被列为已修改，但没有一个文件具有普通模板而不是先前指定的模板。我也愿意为此使用 Powershell，但我还没有研究如何做到这一点，并且此时 VBA 的成本已经下降。

这是我在 Graham Mayor 的工具中使用的函数：

Function TemplateReplace(oDoc As Document) As Boolean
 On Error GoTo Err_Handler
    With ActiveDocument
        .UpdateStylesOnOpen = False
        .AttachedTemplate = _
            ""
    End With
lbl_Exit:
  Exit Function
Err_Handler:
  TemplateReplace = False
  Resume lbl_Exit
End Function

此代码不返回任何错误并声称它已成功完成，但模板仍然显示为先前指定的模板，而不是必需的 normal.dotm。

我还拥有完整的代码，我已成功使用它们来更改目录中所有文档的模板，但不包括子目录，以防更容易修改。此信息来源： https://www.litigationsupporttipofthenight.com/single-post/2020/07/21/vba-code-to-run-a-macro-on-multiple-word-files

Sub RunMacroMultipleFiles()

Dim File

Dim path As String

' this code taken from Running a macro on all files in a folder - Tips for Module Creation

' Path to your folder. MY folder is listed below. I bet yours is different.

' make SURE you include the terminating "\"

'YOU MUST EDIT THIS.

path = "MYPATH"

'Change this file extension to the file you are opening. .htm is listed below. You may have rtf or docx.

'YOU MUST EDIT THIS.

File = Dir(path & "*.docx")

Do While File <> ""

Documents.Open FileName:=path & File

' This is the call to the macro you want to run on each file the folder

'YOU MUST EDIT THIS. You put your Macro name here.

Call TemplateRemoval

' set file to next in Dir

File = Dir()

Loop

End Sub

Sub TemplateRemoval()
'
' TemplateRemoval Macro
'
'
    With ActiveDocument
        
        .UpdateStylesOnOpen = False
        .AttachedTemplate = _
            ""
        .Close _
            SaveChanges:=wdSaveChanges, _
            OriginalFormat:=wdOriginalDocumentFormat
    End With
End Sub

如果第二个代码块可以过滤子目录，那么它就可以工作，但我有超过 300 个目录要浏览，这是不可行的。

Answer 1

这样的东西应该有效：

Sub RunMacroMultipleFiles()

    Const ROOT_PATH As String = "C:\Temp\" 'for example
    
    Dim docFiles As Collection, f As Object, doc As Document
    
    docFiles = GetFileMatches(ROOT_PATH, "*.docx")
    
    For Each f In docFiles
        Set doc = Documents.Open(f.path)
        TemplateRemoval doc 'pass document to `TemplateRemoval`
    Next f
End Sub

Sub TemplateRemoval(doc As Document)
    With doc
        .UpdateStylesOnOpen = False
        .AttachedTemplate = ""
        .Close SaveChanges:=wdSaveChanges, _
            OriginalFormat:=wdOriginalDocumentFormat
    End With
End Sub

'Return a collection of file objects given a starting folder and a file pattern
'  e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function GetFileMatches(startFolder As String, filePattern As String, _
                    Optional subFolders As Boolean = True) As Collection

    Dim fso, fldr, f, subFldr
    Dim colFiles As New Collection
    Dim colSub As New Collection

    Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder

    Do While colSub.Count > 0

        Set fldr = fso.getfolder(colSub(1))
        colSub.Remove 1

        For Each f In fldr.Files
            If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
        Next f

        If subFolders Then
            For Each subFldr In fldr.subFolders
                colSub.Add subFldr.path
            Next subFldr
        End If
    Loop
    Set GetFileMatches = colFiles
End Function