在文件夹内的多个文件中查找和替换文本

Question

下面的代码应该让我 select 一个文件夹，然后在文件夹内的 word 文档中查找和替换句点，并将它们替换为 space。我得到了可以运行的代码，但我的计算机崩溃了，现在我不记得我做了什么，而且我收到 'user-defined type' 错误。我不太确定如何解决这个问题。

我也在尝试让这个从 excel（不仅仅是从 word）开始工作，所以如果有任何帮助，我们将不胜感激。

Sub Step_1() 'select folder with raw files to clean up
Dim wordApp As Word.Application
Dim objDocument As Word.Document

Dim intResult As Integer
Dim strPath As String
Dim arrFiles() As String
Dim i As Integer
'box will open where user can pick folder with raw files
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'checks if user has cancelled the dialog
If intResult <> 0 Then
'display folder search box
strPath = Application.FileDialog( _
msoFileDialogFolderPicker).SelectedItems(1)
arrFiles() = GetAllFilePaths(strPath)
For i = LBound(arrFiles) To UBound(arrFiles)
Call ModifyFile(arrFiles(i))
Next i
End If
End Sub

Private Sub ModifyFile(ByVal strPath As String)
Dim wordApp As Word.Application
Dim objDocument As Word.Document
Set objDocument = wordApp.Documents.Open(strPath)
objDocument.Activate

For Each objDocument In strPath

With Selection.Find

.Text = "."
.Replacement.Text = " "
.Find.Execute Replace:=wdReplaceAll


'there's a much longer list of things to replace

End With
objDocument.Close (True)

Next
Next

End Sub

Private Function GetAllFilePaths(ByVal strPath As String) _
As String()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim arrOutput() As String
ReDim arrOutput(1 To 1)
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(strPath)
i = 1
'loops through each file in the directory and
'prints their names and path
For Each objFile In objFolder.Files
ReDim Preserve arrOutput(1 To i)
'print file path
arrOutput(i) = objFile.Path
i = i + 1
Next objFile
GetAllFilePaths = arrOutput
End Function

Answer 1

已清理：

Sub ProcessFiles()
    
    Dim wordApp As Word.Application
    Dim wdDoc As Word.document
    Dim strPath As String, allfiles As Collection, fPath

    strPath = GetFolderPath()
    If Len(strPath) = 0 Then Exit Sub
    
    Set allfiles = GetAllFiles(strPath, "*.doc*")
    If allfiles.Count = 0 Then
        MsgBox "No Word files found"
        Exit Sub
    End If
    
    Set wordApp = New Word.Application
    wordApp.Visible = True
    
    'loop over found files
    For Each fPath In allfiles
        Debug.Print "Processing " & fPath
        Set wdDoc = wordApp.documents.Open(fPath)
        
        ReplaceDocContent wdDoc, ".", " "
        ReplaceDocContent wdDoc, ",", " "
        ReplaceDocContent wdDoc, "~", " "
        'etc.....
        
        wdDoc.Close True 'close and save changes
    Next fPath
    
    MsgBox "done"
End Sub

'replace text in a Word document with some other text
Private Sub ReplaceDocContent(doc As Word.document, findWhat, replaceWith)
    With doc.Range.Find
        .Text = findWhat
        .Replacement.Text = replaceWith
        .Execute Replace:=wdReplaceAll
    End With
End Sub

'collect all files under folder `strPath` which match `pattern`
Private Function GetAllFiles(ByVal strPath As String, pattern As String) As Collection
    Dim objFile As Object, col As New Collection
    'Create an instance of the FileSystemObject and list all files
    For Each objFile In CreateObject("Scripting.FileSystemObject").GetFolder(strPath).Files
        If objFile.Path Like pattern Then col.Add objFile.Path
    Next objFile
    Set GetAllFiles = col
End Function

'return selected folder path or empty string
Function GetFolderPath() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show <> 0 Then GetFolderPath = .SelectedItems(1)
    End With
End Function

在文件夹内的多个文件中查找和替换文本

Finding and replacing text in multiple files within a folder

excel

vba

ms-word