VBA to automatically replace Modules in several workbooks

[bethredge]

Hello everyone. This is my first time posting here. I have a workbook that my firm has been using over the past two years. This workbook has macros in it and we have been updating those macros, from time to time, by creating an updating workbook that replaces the modules in each workbook. We are now at a point where we need to update over 5,000 of these workbooks and would like to do this automatically without having someone open each one and run the updater. I've put together the code below with the help from a book and Google. When testing it on a folder that contains six files it works perfectly for file 2, 4, and 6. For the other files it imports the new module but fails to remove the old module. Can anyone help me determine where this is messing up? All help is greatly appreciated.


Thank You.

Sub Update_Workbooks()
'This macro requires that a reference to Microsoft Scripting Routine
'be selected under Tools\References in order for it to work.
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim fso As New FileSystemObject
Dim source As Scripting.Folder
Dim wbFile As Scripting.File
Dim book As Excel.Workbook
Dim sheet As Excel.Worksheet
Dim Filename As String
Dim ModuleFile As String
Set source = fso.GetFolder("C:\Users\Desktop\Testing")   'we will know this since all of the files will be in one folder
For Each wbFile In source.Files
If fso.GetExtensionName(wbFile.Name) = "xlsm" Then  'we will konw this too. All files will be .xlsm
Set book = Workbooks.Open(wbFile.path)
    Filename = FileNameOnly(wbFile.Name)
    
On Error GoTo ErrHandle
'   Export Module1 from updating workbook
    ModuleFile = Application.DefaultFilePath & "\tempmodxxx.bas"
    Workbooks("Update Multiple Workbooks.xlsm").VBProject.VBComponents("Module1") _
    .Export ModuleFile
'   Remove existing modules. Will either be Module1 or Module11
    On Error Resume Next
    Set VBP = Workbooks(Filename).VBProject
    With VBP.VBComponents
        .Remove VBP.VBComponents("Module1")
        .Remove VBP.VBComponents("Module11")
    End With
'   Replace Module1 in Userbook
    Set VBP = Workbooks(Filename).VBProject
    On Error Resume Next
    With VBP.VBComponents
        .Import ModuleFile
    End With
'   Delete the temporary module file
    Kill ModuleFile
book.Close True
End If
Next
    Exit Sub
ErrHandle:
'   Did an error occur?
    MsgBox "ERROR. The module may not have been replaced.", _
      vbCritical
    
    
End Sub

 

[Gary McMaster]

Just guessing here, I don't recall ever seeing two different error handlers in one procedure:

On Error GoTo ErrHandle

On Error Resume Next

I don't know which one would get precedence but the "On Error Goto" causes it to exit the procedure without removing the module that is listed second. I would be inclined to try commenting the "On Error Goto", put one On "Error Resume Next" near the top of the procedure and let it blow through any errors. I get the feeling that it exits when it does not find the first listed module and therefore never tries to remove the second.

I think I would also try reversing the order of the following two lines and see if that causes it to work correctly with files 1,3 & 5

.Remove VBP.VBComponents("Module1")
.Remove VBP.VBComponents("Module11")

According to VBA help, On Error Resume Next remains in effect until it is turned off with "On Error Goto 0" or it exits the containing procedure. We had a discussion in this forum several years ago about this help topic. I believe it was proven that help is incorrect. As I recall we discovered that exiting the procedure does not turn it off. In any case you can turn it on near the top and turn it off just before the procedure exits.

There have also been discussions in this forum and others about calling procedures in other workbooks. Maybe you could do that then you could maintain the code in one master workbook and have the other 5K workbooks call the master.

http://www.mrexcel.com/forum/excel-...ons-open-another-instant-excel-run-macro.html

How to run a macro from another workbook?

Hope this helps,

Gary

 

[bethredge]

Gary,

Thank you for responding to my question. I tried doing what you suggested but still got the same results. While I was waiting to see if anyone would respond I was trying to think of another way around my issue in case I didn't get a response. About the time you responded I found a different way to try. I removed this part of the code:

'   Remove existing modules. Will either be Module1 or Module11
    On Error Resume Next
    Set VBP = Workbooks(Filename).VBProject
    With VBP.VBComponents
        .Remove VBP.VBComponents("Module1")
        .Remove VBP.VBComponents("Module11")
    End With

and added this:

On Error Resume Next
    For Each Element In ActiveWorkbook.VBProject.VBComponents
        ActiveWorkbook.VBProject.VBComponents.Remove Element
        Next

I also moved this to the top. Since I sometimes had more than one module and also userforms, this really cut down on having to determine all of the different names of the modules and userforms.

Thank you for the advice on errors. I did not know about that. Also, the links you posted will come in handy in the future. Below is the final code that I used.

Sub Update_Workbooks()
'This macro requires that a reference to Microsoft Scripting Routine
'be selected under Tools\References in order for it to work.
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim fso As New FileSystemObject
Dim source As Scripting.Folder
Dim wbFile As Scripting.File
Dim book As Excel.Workbook
Dim sheet As Excel.Worksheet
Dim Filename As String
Dim ModuleFile As String
Dim Element As Object
Set source = fso.GetFolder("C:\Users\Desktop\Testing")   'we will know this since all of the files will be in one folder
For Each wbFile In source.Files
If fso.GetExtensionName(wbFile.Name) = "xlsm" Then  'we will konw this too. All files will be .xlsm
Set book = Workbooks.Open(wbFile.path)
    Filename = FileNameOnly(wbFile.Name)
    'This will remove all modules including ClassModules and UserForms.
    'It will keep all object modules like (sheets, ThisWorkbook)
    On Error Resume Next
    For Each Element In ActiveWorkbook.VBProject.VBComponents
        ActiveWorkbook.VBProject.VBComponents.Remove Element
        Next
    
    On Error GoTo ErrHandle
'   Export Module1 from updating workbook
    ModuleFile = Application.DefaultFilePath & "\tempmodxxx.bas"
    Workbooks("Update Multiple Workbooks.xlsm").VBProject.VBComponents("Module1") _
    .Export ModuleFile
'   Replace Module1 in Userbook
    Set VBP = Workbooks(Filename).VBProject
    On Error Resume Next
    With VBP.VBComponents
        .Import ModuleFile
    End With
'   Delete the temporary module file
    Kill ModuleFile
    
book.Close True
End If
Next
    Exit Sub
ErrHandle:
'   Did an error occur?
    MsgBox "ERROR. The module may not have been replaced.", _
      vbCritical
End Sub

Thank you for your time, help, and quick response.

 

[Gary McMaster]

Glad you got it working. Thanks for the feedback.

Your double error handler piqued my curiosity. I was surprised to find that it was the "On Error Resume Next" that traps the division by zero error in the sample below. I was almost certain it would have been the "On Error Goto" because it was declared first, interesting ...

Gary

Public Sub Test()

Dim x

On Error GoTo ErrHand

On Error Resume Next

x = 2 / 0

If Err Then
    MsgBox "Resume Next sent me here"
    Err.Clear
End If

Exit Sub

ErrHand:

MsgBox "On Goto sent me here"

End Sub

 

[aclear]

Hi, I am trying to replicate this procedure.
However, when I run the code it breaks at the line:

Filename = FileNameOnly(wbFile.path)
The error message is the the sub or function is not defined.

Is this to do with the referencing? I have referenced the excel to Microsoft Scripting Runtime!?

Thanks for your help.

 

[bethredge]

aclear,

You are probably missing the function that creates "Filename". Put the function below in your module and it should work.

Private Function FileNameOnly(pname) As String
    Dim temp As Variant
    Length = Len(pname)
    temp = Split(pname, Application.PathSeparator)
    FileNameOnly = temp(UBound(temp))
End Function

 

[Norie]

Instead of updating existing code in multiple workbooks consider transferring the code to an add-in.

With the code in an add-in all the workbooks can access it and instead of having to update each workbook you would only need to update the add-in.