创建一个 vba 代码来替换文件夹和子文件夹中所有 word 文档的所有 headers

Question

Sub ReplaceEntireHdr() 
    Dim wrd As Word.Application 
    Set wrd = CreateObject("word.application") 
    wrd.Visible = True 
    AppActivate wrd.Name 
     'Change the directory to YOUR folder's path
    fName = Dir("C:\Users\user1\Desktop\A\*.doc") 
    Do While (fName <> "") 
        With wrd 
             'Change the directory to YOUR folder's path
            .Documents.Open ("C:\Users\user1\Desktop\A\" & fName) 
            If .ActiveWindow.View.SplitSpecial = wdPaneNone Then 
                .ActiveWindow.ActivePane.View.Type = wdPrintView 
            Else 
                .ActiveWindow.View.Type = wdPrintView 
            End If 
            .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 
            .Selection.WholeStory 
            .Selection.Paste 
            .ActiveDocument.Save 
            .ActiveDocument.Close 
        End With 
        fName = Dir 
    Loop 
    Set wrd = Nothing 
End Sub

我使用这个 vba 代码来替换文件夹 'A' 中所有 word 文档的所有 headers。但是，如果 parent 文件夹 'A' 中有任何包含 word 文档的子文件夹，vba 代码会跳过这些文档。谁能告诉我如何将 word 文档也包含在子文件夹中？也许通过对代码或任何其他可以完成相同工作的 vba 代码进行一些更改。提前致谢。

Answer 1

为了获取文件夹（目录），您需要指定 vbDirectory 属性。默认情况下，Dir 只有 "sees" 匹配 vbNormal 的东西。

这是一个同时选取文件和子目录的示例。 GetAttr 函数检查文件属性是否为 vbDirectory。如果不是，那么它就是一个文件。

你可以做的是将目录路径保存在一个数组中，然后循环获取子目录中的文件。

Sub GetFilesandSubDir()
  Dim sPath As String, sPattern As String
  Dim sSearch As String, sFile As String
  Dim sPathSub As String, sSearchSub As String
  Dim aSubDirs As Variant, i As Long

  sPattern = "*.*"
  sPath = "C:\Test\"
  sSearch = sPath & sPattern
  sFile = Dir(sPath, vbNormal + vbDirectory)
  aSubDirs = TestDirWithSubFolders(sPath, sPattern, sSearch, sFile)
  For i = LBound(aSubDirs) To UBound(aSubDirs)
    Debug.Print "Directory: " & aSubDirs(i)
    sPathSub = sPath & aSubDirs(i) & "\"
    sSearchSub = sPathSub & sPattern
    sFile = Dir(sPathSub, vbNormal + vbDirectory)
    TestDirWithSubFolders sPathSub, sPattern, sSearchSub, sFile
  Next
End Sub

Function TestDirWithSubFolders(sPath As String, sPattern As String, _
      sSearch As String, sFile As String) As Variant
  Dim aSubDirs() As Variant, i As Long

  i = 0
  Do While sFile <> ""
    If GetAttr(sPath & sFile) = vbDirectory Then
        'Debug.Print "Directory: " & sFile
        ReDim Preserve aSubDirs(i)
        aSubDirs(i) = sFile
        i = i + 1
    Else
        Debug.Print "File: " & sFile
    End If
    sFile = Dir
  Loop
  TestDirWithSubFolders = aSubDirs
End Function

创建一个 vba 代码来替换文件夹和子文件夹中所有 word 文档的所有 headers

Create a vba code to replace all the headers, of all the word documents in a Folder and Subfolders

vba

office-2007

ms-word