How can I update a macro in hundreds of excel files?

Question

We have a share folder at work where users open an excel workbook, fill out data and then run a macro that creates a subfolder and copies a version of the workbook into that folder. The subfolder and new workbook are named based on the data entered into the form.

Sometime in the future that new workbook is opened, revisions made and new version of the workbook (with a revision name) is created in the subfolder. Rinse and repeat. It's god awful.

Easily a thousand of these self-replicating borg excel spreadsheets exist. The biggest rub? Hard coded path to the root path in the macros. And now that root folder has to be moved.

I'm not an excel user myself, but I need to solve this problem. Is there something I can write in .Net (or anything else) to walk the root & sub folders, and update each Excel file it finds to change the path? All of course without harming the data in each spreadsheet?!

Any help appreciated.

---

EDIT: (So you do not need to mine the comments) The below solution by @brettdj works out of the box. For my situation I did move it out of Sub Main() and I needed to change the following line from his example:

bFound = .Find("C:\test\xxx", SL, SC, EL, EC, True, False, False)

to

bFound = .Find("C:\test\xxx", SL, SC, EL, EC, False, False, False)

Which I believe changes the find to NOT match whole word.

I had a additional problem of the VBA project being password protected, which I currently have not solved yet, but @brettdj has suggested this possible solution.

EDIT 2: The VBA project password solution works! I've also moved @brettdj code samples into a vb.net project and now have a loop over all files over 400k, checking if the password is needed, unlock it if so, search the code for the offending line, replacing it if found, and then save if modified. So overall, cool beans.

Answer 1

VBA Solution

1. This code runs a recursive Dir on on a folder set by strStartFolder = "c:\temp"
2. It opens all Excel files, and then uses Pearson's method to identify and replace a certain string in the four code-module types:
   "c:\temp\xxx"
   with
   "d:\temp\yyy"
3. The code then saves the adjusted workbook (but simply closes unaltered workbooks)
4. A summary file of changes made is then provided to the user

One of the idiosyncrasies of coding the VBE was that using a string variable here failed:
bFound = .Find(strOld, SL, SC, EL, EC, True, False, False)
I had to hard code the string to replace instead
bFound = .Find("c:\temp\xxx", SL, SC, EL, EC, True, False, False)

 Option Explicit

Public StrArray()
Public lngCnt As Long

Public Sub Main()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim WB As Workbook
    Dim ws As Worksheet
    Dim strStartFolder As String

     'Setup Application for the user
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

     'reset public variables
    lngCnt = 0
    ReDim StrArray(1 To 4, 1 To 1000)

    strStartFolder = "c:\temp"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strStartFolder)

     ' Format output sheet
    Set WB = Workbooks.Add(1)
    Set ws = WB.Worksheets(1)
    ws.[a1] = Now()
    ws.[a2] = strStartFolder
    ws.[a1:a3].HorizontalAlignment = xlLeft

    ws.[A4:D4].Value = Array("Folder", "File", "Code Module", "line")
    ws.Range([a1], [c4]).Font.Bold = True
    ws.Rows(5).Select
    ActiveWindow.FreezePanes = True


     ' Start the code to gather the files
    ShowSubFolders objFolder, True
    ShowSubFolders objFolder, False

    If lngCnt > 0 Then
         ' Finalise output
        With ws.Range(ws.[a5], ws.Cells(5 + lngCnt - 1, 4))
            .Value2 = Application.Transpose(StrArray)
            .Offset(-1, 0).Resize(Rows.Count - 3, 4).AutoFilter
            .Offset(-4, 0).Resize(Rows.Count, 4).Columns.AutoFit
        End With
        ws.[a1].Activate
    Else
        MsgBox "No files found!", vbCritical
        WB.Close False
    End If

     ' tidy up

    Set objFSO = Nothing

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .StatusBar = vbNullString
    End With
End Sub


Sub ShowSubFolders(ByVal objFolder, bRootFolder As Boolean)

    Dim colFolders As Object
    Dim objSubfolder As Object
    Dim WB As Workbook
    Dim strOld As String
    Dim strNew As String
    Dim strFname As String

    Dim VBProj As Object
    Dim VBComp As Object
    Dim CodeMod As Object
    Dim bFound As Boolean
    Dim bWBFound As Boolean

    Dim SL As Long
    Dim SC As Long
    Dim EL As Long
    Dim EC As Long
    Dim S As String


    strOld = "c:\temp\xxx"
    strNew = "D:\temp\yyy"

    Set colFolders = objFolder.SubFolders
    Application.StatusBar = "Processing " & objFolder.Path

    If bRootFolder Then
        Set objSubfolder = objFolder
        GoTo OneTimeRoot
    End If

    For Each objSubfolder In colFolders
         'check to see if root directory files are to be processed
OneTimeRoot:
        strFname = Dir(objSubfolder.Path & "\*.xls*")
        Do While Len(strFname) > 0
            Set WB = Workbooks.Open(objSubfolder.Path & "\" & strFname, False)
            Set VBProj = WB.VBProject
            For Each VBComp In VBProj.vbcomponents
                    Set CodeMod = VBComp.CodeModule
                    With CodeMod
                        SL = 1
                        EL = .CountOfLines
                        SC = 1
                        EC = 255
                        bFound = .Find("C:\test\xxx", SL, SC, EL, EC, True, False, False)
                         'bFound = .Find(strOld, SL, SC, EL, EC, True, False, False)
                        If bFound Then bWBFound = True
                        Do Until bFound = False
                            lngCnt = lngCnt + 1
                            If UBound(StrArray, 2) Mod 1000 = 0 Then ReDim Preserve StrArray(1 To 4, 1 To UBound(StrArray, 2) + 1000)
                            StrArray(1, lngCnt) = objSubfolder.Path
                            StrArray(2, lngCnt) = WB.Name
                            StrArray(3, lngCnt) = CodeMod.Name
                            StrArray(4, lngCnt) = SL
                            EL = .CountOfLines
                            SC = EC + 1
                            EC = 255
                            S = .Lines(SL, 1)
                            S = Replace(S, "C:\test\xxx", "D:\test\yyy")
                            .ReplaceLine SL, S
                            bFound = .Find("C:\test\xxx", SL, SC, EL, EC, True, False, False)
                        Loop
                    End With
            Next
            If bWBFound Then WB.Save
            WB.Close False
            strFname = Dir
        Loop
        If bRootFolder Then
            bRootFolder = False
            Exit Sub
        End If
        ShowSubFolders objSubfolder, False
    Next
End Sub