Update multiple XLSM spreadsheets using VBA

As part of a migration I needed to change the hard-code connections within a ‘WSSI’ application (a suit of dynamic spreadsheets used for stock-control). In essence this was a folder in a shared-location containing hundreds of ‘xlsm’ spreadsheets in sub-folders.

To do this manually I would have had to open each spreadsheet one-by-one, press ALT-F11, navigate down the tree in the top-left pane, opening MODULES then CONSTANTS. Then change the hard-coded values EG: [Public Const DB_SERVER As string = “Old-Name”] and type in the “New-Name” before saving.

** This would have taken days as there were hundreds of them **

I was able to semi-automated the process and completed it in an hour. Here’s how …

– I copied the root folder to my C-Drive
– Created a new XLSM spreadsheet on my desktop
– Opened this File \ Options \ Trust Center \ Trust Center Settings \ Macro Settings
– and ticked “Trust access to the VBA project model”
– saved it as [wssi_mod.xlsm]
– selected any cell and typed ALT-F11 (to develop)
– In the top-left pane I right-clicked on “Sheet1”, Insert \ Module
– in the right-hand pane I pasted this VBA

Option Explicit

Sub Test()
  Dim Path As String, FName As String
  Dim SearchFor As String, ReplaceWith As String, Contents As String
  Dim Wb As Excel.Workbook
  Dim vbComp As Object 'VBIDE.VBComponent
  Dim Changed As Boolean
  
  'Customize this:
   Path = "C:\WSSI_2014\Dairy\"
     SearchFor = "Public Const DB_SERVER As String = ""old-name"""
   ReplaceWith = "Public Const DB_SERVER As String = ""new-name"""
    
  'Prepare Excel
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  'Find the first file
  FName = Dir(Path & "*.xlsm")
  'While found
  Do While FName  ""
    'Open the file
    Set Wb = Workbooks.Open(Path & FName, False, False)
    Changed = False
    'For each module
    For Each vbComp In Wb.VBProject.VBComponents
      With vbComp.CodeModule
        'Any lines?
        If .CountOfLines > 0 Then
          'Get them
          Contents = .Lines(1, .CountOfLines)
          If InStr(1, Contents, SearchFor, vbTextCompare) > 0 Then
            Contents = Replace(Contents, SearchFor, ReplaceWith, , , vbTextCompare)
            'Replace the contents with the modified string
            .DeleteLines 1, .CountOfLines
            .InsertLines 1, Contents
            'Clean empty lines at the top and bottom
            Do While Len(Trim$(.Lines(1, 1))) = 0
              .DeleteLines 1, 1
            Loop
            Do While Len(Trim$(.Lines(.CountOfLines, 1))) = 0
              .DeleteLines .CountOfLines, 1
            Loop
            Changed = True
          End If
        End If
      End With
    Next
    'Close the file, save if necessary
    Wb.Close Changed
    'Next file
    FName = Dir
  Loop
  
  'Done
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

– I customized the “Customize this” section as appropriate
– saved and closed [wssi_mod.xlsm]
– then ran it by opening it and typing ALT-F8 (run)
– I noticed the “Date modified” property of the files had all been updated
– and opened a few to confirmed the changes had been completed correctly
– then I changed the path in the “Customize this” to the next sub-folder before saving and running again
– lastly I coped the whole lot back to the shared-drive