I have Microsoft VBA Code to bulk Find and Replace in .word files - it it possible to edit to

Question

I was provided the code below through the Microsoft support service to help me go through and batch "find and replace" specific text in a large number of word documents. The use case for this is that have approximately 50 folders with (3) Word Documents and (2) Excel documents that are all laid out the same - I am trying to find a way so that this code not only modifies the word documents, but the Excel docs as well ideally through the same UI as it is quite user-friendly.

I have included the modules that are in the document and would love any help in modifying it to help include Excel docs as well. I really have no level of familiarity with VBA but am really trying to learn, so any help or feedback would be greatly appreciated!

Master Find & Replace Module:

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

Ribbon Buttons Module

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

Special Folders Module:

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

Thank you again, and I hope somebody can help me out!

Answer 1

That's awful code for simply processing a bunch of Word documents.

See the code I posted here Mass Find & Replace including subfolders for something far more elegant.

You could use something similar for Excel, mostly using the same code but with the UpdateDocuments sub modified to work with Excel and its Find/Replace methods. (To avoid confusion, I'd be inclined to change both the sub's name and the code that calls it too.)