創建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