我有Microsoft VBA代码可以批量查找和替换.word文件 - 可以编辑到

Question

我通过Microsoft支持服务提供了下面的代码，以帮助我通过大量Word文档中的“查找并替换”特定文本。用例的用例是，大约有50个文件夹，其中包含（3）个Word文档和（2）Excel文档，这些文件都相同 - 我正在尝试找到一种方法，以便此代码不仅修改了Word Documents，还可以修改Excel文档也理想地通过相同的UI，因为它非常友好。

我包括文档中的模块，并希望对其进行修改以帮助包括Excel文档。我确实对VBA没有水平的熟悉程度，但是我真的在尝试学习，因此，任何帮助或反馈都将不胜感激！

大师查找＆amp;替换模块：

Option Explicit
Public p_strQLPathAndName As String
Public p_PathToUse As String
Public p_colRecentFiles As Collection
Private myFrm As UserInterface
Sub CallUserInterface()
  p_strQLPathAndName = GetSpecialfolder(CSIDL_PERSONAL) & "\QuickList.docx"
  Set myFrm = New UserInterface
  ResetFRParameters
  myFrm.Show vbModeless
lbl_Exit:
  Exit Sub
End Sub
Sub KillUserInterface(ByVal strQuickList As String)
  On Error GoTo Handler
  If Dir$(strQuickList) <> "" Then Kill strQuickList
  If Not myFrm Is Nothing Then Unload myFrm
  Set myFrm = Nothing
lbl_Exit:
  Exit Sub
Handler:
  If Err.Number = 70 Then
    Documents(strQuickList).Close wdDoNotSaveChanges
    Kill strQuickList
    Resume Next
  Else
    MsgBox Err.Number & " " & Err.Description
    Err.Clear
    Unload UserInterface
  End If
End Sub
Sub ResetFRParameters()
  On Error Resume Next
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
lbl_Exit:
  Exit Sub
End Sub
Sub PreserveRecentFilesList()
  Dim i As Long
  Set p_colRecentFiles = New Collection
  For i = 1 To Application.RecentFiles.Count
    On Error Resume Next
    p_colRecentFiles.Add Application.RecentFiles(i).Path & "\" & Application.RecentFiles(i).Name
    On Error GoTo 0
  Next i
lbl_Exit:
  Exit Sub
End Sub
Function PickFolder() As String
'Note: You must use Tools>Referenes to add a reference to Microsoft Scripting Runtime
Dim oFSO As New FileSystemObject
Dim oFD As FileDialog
Dim AbsolutePath As String
Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
With oFD
  .Title = "Select the folder containing the batch of files to process"
  .AllowMultiSelect = False
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    AbsolutePath = oFSO.GetAbsolutePathName(.SelectedItems(1))
  Else
    PickFolder = ""
    Exit Function
  End If
End With
If Right(AbsolutePath, 1) = "\" Then
  PickFolder = "Invalid Selection"
Else
  PickFolder = AbsolutePath
End If
'Err_ReEntry:
Set oFD = Nothing
Exit Function
'Err_Handler:
'PickFolder = "Error"
'Err.Clear
'Resume Err_ReEntry
End Function
Function CheckFileValidity(ByRef oFile As Scripting.File) As Boolean
'This might be overkill but it seems to catch all valid file types.
CheckFileValidity = False
If InStr(oFile.Name, "~") = 1 Then
  Exit Function
End If
Select Case oFile.Type
  Case Is = "Word Document"
    CheckFileValidity = True
    Exit Function
  Case Is = "Word Template"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Office Word Document"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Office Word Macro-Enabled Document"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Office Word Template"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Office Word Macro-Enabled Template"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Office Word 97 - 2003 Document"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Office Word 97 - 2003 Template"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Office Word 2007 Document"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Office Word 2007 Template"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Word Document"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Word Template"
    CheckFileValidity = True
    Exit Function
  Case Is = "Text Document"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Word Backup Document"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Office Word Backcup Document"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Word 2007 Backup Document"
    CheckFileValidity = True
    Exit Function
  Case Is = "Microsoft Office Word 97 - 2003 Backcup Document"
    CheckFileValidity = True
    Exit Function
  Case Else
    If InStr(1, oFile.Type, "Word", vbTextCompare) Then
      If InStr(1, oFile.Type, "Document", vbTextCompare) Or _
        InStr(1, oFile.Type, "Template", vbTextCompare) Then
          CheckFileValidity = True
          Exit Function
        End If
      End If
End Select
End Function

功能区按钮模块

Option Explicit
Sub FNRButtonOnAction(control As IRibbonControl)
Select Case control.ID
  Case "Custombutton727748502"
    CallUserInterface
End Select
End Sub

特殊文件夹模块：

Option Explicit
Public Const CSIDL_PERSONAL = &H5
Public Const CSIDL_DESKTOPDIRECTORY = &H10
Public Const MAX_PATH = 260
Public Const NOERROR = 0
#If VBA7 Then
  Declare PtrSafe Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As LongPtr, ByVal nFolder As Long, pidl As ITEMIDLIST) As LongPtr
  Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As LongPtr
  Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As LongPtr
  Public Type EMID
    cb As LongPtr
    abID As Byte
  End Type
#Else
  Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
  Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
  Public Type EMID
    cb As Long
    abID As Byte
  End Type
#End If
Public Type ITEMIDLIST
  mkid As EMID
End Type


Public Function GetSpecialfolder(CSIDL As Long) As String
Dim IDL As ITEMIDLIST
Dim strPath As String
#If VBA7 Then
  Dim lngFolder As LongPtr
#Else
  Dim lngFolder As Long
#End If
  lngFolder = SHGetSpecialFolderLocation(100, CSIDL, IDL)
  If lngFolder = NOERROR Then
    strPath = Space(512)
    lngFolder = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal strPath)
    strPath = RTrim$(strPath)
    If Asc(Right(strPath, 1)) = 0 Then strPath = Left$(strPath, Len(strPath) - 1)
    GetSpecialfolder = strPath
    Exit Function
  End If
  GetSpecialfolder = ""
lbl_Exit:
  Exit Function
End Function

再次感谢您，希望有人可以帮助我！

Answer 1

这是简单地处理一堆Word文档的糟糕代码。

请参阅我在此处发布的代码 mass find＆amp;更换包括子文件夹更优雅的东西。

您可以对Excel使用类似的东西，主要使用相同的代码，但使用 UpdatedOcuments sub修改以与Excel及其查找/替换方法一起使用。 （为避免混乱，我倾向于更改子的名称和称呼它的代码。）