Copy Module to External Workbook

Partjob

Board Regular
Joined
Apr 17, 2008
Messages
139
I have been trying for some days to copy a module to an external workbook with VBA. I have about 40 workbooks that have the same format. although I developed these sheets. I am not the person who uses them. I have to on occasion alter the code for some reason, its getting tiresome.

I don't think I can use the personal workbook method for this as it is not me using the workbooks. I don't even know some of the people that use them. This courses me problems because of the number of workbooks. I want to be able to maintain the code by having to write it once and propagate it through the necessary files via the VBA.
I have code from C Pearson that copies a module to another workbook.
I have posted this here just in case. Most threads on this subject just direct you here any way.
Code:
Function CopyModule(ModuleName As String, _
    FromVBProject As VBIDE.VBProject, _
    ToVBProject As VBIDE.VBProject, _
    OverwriteExisting As Boolean) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' CopyModule
    ' This function copies a module from one VBProject to
    ' another. It returns True if successful or  False
    ' if an error occurs.
    '
    ' Parameters:
    ' --------------------------------
    ' FromVBProject         The VBProject that contains the module
    '                       to be copied.
    '
    ' ToVBProject           The VBProject into which the module is
    '                       to be copied.
    '
    ' ModuleName            The name of the module to copy.
    '
    ' OverwriteExisting     If True, the VBComponent named ModuleName
    '                       in ToVBProject will be removed before
    '                       importing the module. If False and
    '                       a VBComponent named ModuleName exists
    '                       in ToVBProject, the code will return
    '                       False.
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    Dim VBComp As VBIDE.VBComponent
    Dim FName As String
    Dim CompName As String
    Dim S As String
    Dim SlashPos As Long
    Dim ExtPos As Long
    Dim TempVBComp As VBIDE.VBComponent
    
   [COLOR=red] Set FromVBProject = Application.Workbooks("Original.xls").VBProject
    Set ToVBProject = Application.Workbooks("C:\Documents and Settings\dmasters\Desktop\VBA Test\Workbook.xls")
    Set ModuleName = ActiveWorkbook.VBProject.VBComponents("Module3").CodeModule
    Set OverwriteExisting = True
[/COLOR]    '''''''''''''''''''''''''''''''''''''''''''''
    ' Do some housekeeping validation.
    '''''''''''''''''''''''''''''''''''''''''''''
    If FromVBProject Is Nothing Then
        CopyModule = False
        Exit Function
    End If
    
    If Trim(ModuleName) = vbNullString Then
        CopyModule = False
        Exit Function
    End If
    
    If ToVBProject Is Nothing Then
        CopyModule = False
        Exit Function
    End If
    
    If FromVBProject.Protection = vbext_pp_locked Then
        CopyModule = False
        Exit Function
    End If
    
    If ToVBProject.Protection = vbext_pp_locked Then
        CopyModule = False
        Exit Function
    End If
    
    On Error Resume Next
    Set VBComp = FromVBProject.VBComponents(ModuleName)
    If Err.Number <> 0 Then
        CopyModule = False
        Exit Function
    End If
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' FName is the name of the temporary file to be
    ' used in the Export/Import code.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    FName = Environ("Temp") & "\" & ModuleName & ".bas"
    If OverwriteExisting = True Then
        ''''''''''''''''''''''''''''''''''''''
        ' If OverwriteExisting is True, Kill
        ' the existing temp file and remove
        ' the existing VBComponent from the
        ' ToVBProject.
        ''''''''''''''''''''''''''''''''''''''
        If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
            Err.Clear
            Kill FName
            If Err.Number <> 0 Then
                CopyModule = False
                Exit Function
            End If
        End If
        With ToVBProject.VBComponents
            .Remove .Item(ModuleName)
        End With
    Else
        '''''''''''''''''''''''''''''''''''''''''
        ' OverwriteExisting is False. If there is
        ' already a VBComponent named ModuleName,
        ' exit with a return code of False.
        ''''''''''''''''''''''''''''''''''''''''''
        Err.Clear
        Set VBComp = ToVBProject.VBComponents(ModuleName)
        If Err.Number <> 0 Then
            If Err.Number = 9 Then
                ' module doesn't exist. ignore error.
            Else
                ' other error. get out with return value of False
                CopyModule = False
                Exit Function
            End If
        End If
    End If
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Do the Export and Import operation using FName
    ' and then Kill FName.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    FromVBProject.VBComponents(ModuleName).Export Filename:=FName
    
    '''''''''''''''''''''''''''''''''''''
    ' Extract the module name from the
    ' export file name.
    '''''''''''''''''''''''''''''''''''''
    SlashPos = InStrRev(FName, "\")
    ExtPos = InStrRev(FName, ".")
    CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1)
    
    ''''''''''''''''''''''''''''''''''''''''''''''
    ' Document modules (SheetX and ThisWorkbook)
    ' cannot be removed. So, if we are working with
    ' a document object, delete all code in that
    ' component and add the lines of FName
    ' back in to the module.
    ''''''''''''''''''''''''''''''''''''''''''''''
    Set VBComp = Nothing
    Set VBComp = ToVBProject.VBComponents(CompName)
    
    If VBComp Is Nothing Then
        ToVBProject.VBComponents.Import Filename:=FName
    Else
        If VBComp.Type = vbext_ct_Document Then
            ' VBComp is destination module
            Set TempVBComp = ToVBProject.VBComponents.Import(FName)
            ' TempVBComp is source module
            With VBComp.CodeModule
                .DeleteLines 1, .CountOfLines
                S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
                .InsertLines 1, S
            End With
            On Error GoTo 0
            ToVBProject.VBComponents.Remove TempVBComp
        End If
    End If
    Kill FName
    CopyModule = True
End Function

I have coloured red the part I have put in where I think I have to "Set Parameters" I am just not sure about this bit. I can not get it right. I don't understand how these Parameters work. How do you state in the code where the target workbook is. the only one I think I have correct is the overwrite existing.

I am just trying to get this to work at the moment just as a test so I can get a better understanding of what is going on. I have a folder on my desktop with 2 workbooks in it. One called "Original" I have the above code in Module 1 in this workbook. In Module 3 I have the code I want to copy to the other workbook called "Workbook"
I try and call this function in Module 2 with the very simple
Code:
Sub CopyCode()
Call CopyModule
End Sub
It seems I have to state the variables in the call statement, I can't get this right either.
I have the feeling this all going to blatantly obvious once I have right.

My goal is to have this loop through all the workbooks and change the code when necessary instead of me opening each and every workbook and altering the code.
Thanks a lot for any help or advise.
Partjob
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Forget everything, just see if this works.

1) Create a new blank folder C:\temp\ExcelFiles. Copy all excel files into this folder for which you want to update the modules.

2) Copy the modules file and save it. This file has a .bas extension, save it to C:\temp folder. (Not the same folder as excel files). In this example it is called script.bas.

3) Open Excel. Goto Tools - Macros - Security - Trusted Publishers - Select the checkbox "Check Access to Visual Basic Project" - Click Ok.

4) Go back to Tools - Visual Basic Editor and run the code given below in a new module. This should automatically import the .bas file into all Excel sheets in c:\temp\excelfiles folder. Hope this helps.

Code:
Sub ImportModules()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objfolder = objFSO.getfolder("C:\Temp\ExcelFiles")
    For Each f In objfolder.Files
        Workbooks.Open f.Path, , False
        ActiveWorkbook.VBProject.VBComponents.Import "c:\temp\script.bas"
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Next
End Sub

5) Once complete go back to Trusted Publishers and untick the box.

If you have any doubts, give me a shout.
 
Upvote 0
Nirvana
Thanks for your reply.
I was going to wait till Monday to do this at work, I couldn't resist though and have had a go at home.
I got it to work.
I need some further advise though.
I had three workbooks with nothing in them in the ExcelFiles folder. In the next folder up "Temp" I had by bas. file and the workbook with your code in.
The first time I ran it had the desired effect and created a module 3 in each of the workbooks in the "Excelfolders" folder, brilliant. When I ran it again though I end up with "Module 31" in each target workbook. I need to be able to overwrite the existing module I want to change. I need to able to alter the module in each workbook by this method.
In the code I posted there was an augument to say whether you wanted to overwrite or not. I am not sure where in your code I would state this.
Can I just state for the record that is an amazing bit of VBA and far easier to understand than the code I had.
One more thing as long as I had the file path correct could I have the target workbooks anywhere. My aim is to have a loop going through the folders where these files are propegating the code. I know how to do this.
Thanks a lot for your help.
Partjob
 
Upvote 0
Just a few more lines to add to the code. You may need to remember a few things though.

1) You can change the excel folder path to any folder. Does not have to be "C:\temp\ExcelFiles"
2) You can place the .bas file in any location. Does not have to be "C:\temp\script.bas".
3) I have refined the search only to replace modules in "xls" files, so it doesn't matter if other files exist in the destination folder.
4) *** Most important ***. When ALL xls files are searched they all have to contain a module by name "Module1" which needs to be removed first. Highlighted in red. The script will return an runtime error if Module1 is not found.

Hope this helps.

Rich (BB code):
Sub ImportModules()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.getfolder("C:\Temp\ExcelFiles")
    For Each f In objFolder.Files
        If objFSO.GetExtensionName(f.Path) = "xls" Then
            Workbooks.Open f.Path, , False
            ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module1")
            ActiveWorkbook.VBProject.VBComponents.Import "c:\temp\script.bas"
            ActiveWorkbook.Save
            ActiveWorkbook.Close
        End If
    Next
End Sub
 
Last edited:
Upvote 0
Nirvana
What can I say but absolutely brilliant, this tiny snippet of code is going to save me hours. Still just testing at home but I can see what it does.
thanks so much for your help.
Partjob
 
Upvote 0
One thing to remember is that this code will update modules to all the xls files in the given folder. There may be some file for which you may not want to update the module to. To get around this problem you can specify a single file as given below.

Use whichever suits you best.

Code:
Sub ImportModules()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.getfolder("C:\Temp\ExcelFiles")
    For Each f In objFolder.Files
        If objFSO.GetExtensionName(f.Path) = "xls" and [COLOR=red]f.Path = "C:\Temp\ExcelFiles\Myfile.xls" [/COLOR]Then
            Workbooks.Open f.Path, , False
[COLOR=black]            ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module1")[/COLOR]
            ActiveWorkbook.VBProject.VBComponents.Import "c:\temp\script.bas"
            ActiveWorkbook.Save
            ActiveWorkbook.Close
        End If
    Next
End Sub
 
Upvote 0
Nervana
I think you foresaw my next problem I would need to specify a particular file. I think that just about covers it. Yet again your solution a lot less complecated than the searching inside strings as I was going to it. There is a lot to be aid about keeping it simple.
Thanks for your help
Partjob
 
Upvote 0
Here is something a lot more simpler.

1) Open excel and write the path for all the files starting from cell A1 downwards. It should include all the excel files you want to replace the modules on.

eg.
A1 should have something like C:\temp\Testfile.xls
A2 should have something like C:\temp\My Excel File.xls
A3 should have something like C:\My Documents\Test.xls
....

2) Once you have written all the files open VB editor and run this code. It will now replace all the "Module1" with the .bas file for all the files listed in Column A. You will not have to run the code individually against each file. Also the files dont need to be in the same folder. All files will get updated within a minute. Hope this helps.

Code:
Sub ImportModules()
    Dim i As Integer
    i = 1
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Do While Worksheets(1).Cells(i, 1) <> ""
        Set objFile = objFSO.GetFile(Worksheets(1).Cells(i, 1))
        Workbooks.Open objFile, , False
        ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module1")
        ActiveWorkbook.VBProject.VBComponents.Import "c:\temp\script.bas"
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        i = i + 1
    Loop
End Sub
 
Upvote 0
so how would i go about copying a module from one workbook to another during runtime? i am creating a copy of a workbook and i need some code from the original to go to the new.
thanks!
 
Upvote 0
As I understand things when you do a save as the code is replecated.
however if you don't want all the code that is a different problem. you need some code to delete the bits you don't want. I use some code to completely delete all code but not parts of it. It can be done I just don't know how.

Partjob
 
Upvote 0

Forum statistics

Threads
1,215,084
Messages
6,123,029
Members
449,092
Latest member
ikke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top