创建vba代码来替换文件夹和子文件夹中所有word文档的所有标题

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”中所有文档的所有标题。但是，如果父文件夹“A”中的任何子文件夹含有word文档，vba代码将跳过这些文档。任何人都可以请告诉我如何在子文件夹中包含word文档？也许通过对代码或任何其他可以完成相同工作的vba代码进行一些更改。 在此先感谢。

Answer 1

为了选取文件夹（目录），您需要指定vbDirectory属性。默认情况下，Dir只会“看到”与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