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)
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.
- This code runs a recursive Dir on on a folder set by
strStartFolder = "c:\temp"
- It opens all Excel files, and then uses Pearson’s method to identify and replace a certain string in the four code-module types:
- The code then saves the adjusted workbook (but simply closes unaltered workbooks)
- 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