替换子文件夹vba中的文档中的文本

时间:2015-06-24 13:09:07

标签: vba word-vba

我发现这个帖子与我的问题相同,但是我已经将代码复制到我的项目中,但似乎没有用。

VBA macro: replace text in word file in all sub folders

我正在逐步完成代码,然后它到达第32行(在colSubFolders中的For Each varItem下),然后它跳过查找/替换部分直到代码的末尾。问题是我的文件格式吗?

EDIT:另外,当我在ln 31中找到varitem时,“varitem”的值是文件夹的名称,而不是文件夹中word文档的名称:我认为这就是问题所在。

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 = "L:\Admin\Corporate Books\2015\2014 Consents macro\company Annual Consents"
     ' 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)

1 个答案:

答案 0 :(得分:0)

使用CMD将所有文件放入数组并使用它 - 更快更干净。

Sub S_O()

Dim fileArray As Variant

fileArray = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & strFolder & "\*.doc*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")

For Each fil In fileArray
    '//
    '// Insert your code for doing the replacements here
    '// e.g. Workbooks.Open(fil)
    '// ...
Next

End Sub