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

时间:2016-02-03 10:51:23

标签: vba ms-word word-vba office-2007

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文档的所有标题。但是,如果父文件夹“A”中包含word文档的子文件夹,则vba代码会跳过这些文档。有谁能告诉我如何在子文件夹中包含word文档?也许通过对代码或任何其他可以执行相同工作的vba代码进行一些更改。 提前谢谢。

1 个答案:

答案 0 :(得分:0)

要获取文件夹(目录),您需要指定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