VBA宏:替换所有子文件夹中的word文件中的文本

时间:2013-06-04 01:17:11

标签: vba replace ms-word word-vba

我正在整理一个VBA宏:

1.读取文件夹

2.创建其所有子文件夹的集合

3.浏览所有子文件夹,找到以.doc

结尾的任何word文档

4.在每个.doc文件中:替换一些文本然后保存然后关闭文档。

此宏无法正常工作:它不会替换子文件夹中任何word文档中的文本。 它没有实际打开任何word文档,我不确定它应该一个接一个地打开每个单词doc还是它在后台运行。

Sub DoLangesNow()
Dim file
Dim path As String
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant

 ' Parent folder including trailing backslash
 'YOU MUST EDIT THIS.
     strFolder = "G:\2009\09771\Design\ESD\Commercial Tower KSD1\Green Star As Built\Round 1 Submission - Draft\02. Indoor Environment Quality"

     ' Loop through the subfolders and fill Collection object
     strSubFolder = Dir(strFolder & "*", vbDirectory)
     Do While Not strSubFolder = ""
         Select Case strSubFolder
             Case ".", ".."
                 ' Current folder or parent folder - ignore
             Case Else
                 ' Add to collection
                 colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
         End Select
         ' On to the next one
         strSubFolder = Dir
     Loop
     ' Loop through the collection
     For Each varItem In colSubFolders
         ' Loop through word docs in subfolder
         'YOU MUST EDIT THIS if you want to change the files extension
         strFile = Dir(strFolder & varItem & "*.doc")
         Do While strFile <> ""
         Set file = Documents.Open(FileName:=strFolder & _
                 varItem & "\" & strFile)

' Start of macro 1replace text GS-XXXAB  with GS-1624AB
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Application.WindowState = wdWindowStateNormal
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "GS-XXXAB "
        .Replacement.Text = "GS-1624AB "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
' End of macro 1
' Saves the file
ActiveDocument.Save
ActiveDocument.Close
' set file to next in Dir
strFile = Dir
         Loop
     Next varItem
 End Sub

1 个答案:

答案 0 :(得分:0)

您的代码适用于我,但有以下更改

    strFile = Dir(strFolder & varItem & "*.doc")

要   

  strFile = Dir(strFolder & varItem & "\" & "*.doc")

  • 确保strFolder变量中文件夹的路径正确无误。例如(strFolder = "C:\Users\Santosh\Desktop\tes\“)