Lannister
Lannister

Reputation: 23

VBA: Copying a Worksheet Macro to the Personal Workbook

I have a series of macros that I need to be able to distribute to my team for use over several different workbooks. In the past I would manually 'install' macros for people into their Personal workbook space but this would take too much time now with the number of people that are using the macros.

I want to create a workbook that has macros I want to have copied to PERSONAL.XLSB and then have a button that copies them there. (bonus points for putting them on the Quick Access Toolbar at the top)

Example:

I have a workbook called macroCopyTestBook.xlsx and I want to copy the copyThisModule module to the PERSONAL.XLSB. I've tried taking an answer to a similar question and using it for this but it doesn't work. I get:

run-time error 424 Object Required on the first line of the copyTest().

Sub copyTest()
If (CopyModule("copyThisModule", macroCopyTestBook.xlsx.VBProject, PERSONAL.XLSB, False)) Then
    MsgBox "Copy went!"
Else
    MsgBox "Copy failed!"
End If

End Sub

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

'''''''''''''''''''''''''''''''''''''''''''''
' 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

Upvotes: 2

Views: 900

Answers (2)

Steen BN CPH-DK
Steen BN CPH-DK

Reputation: 11

You could also use the build-in tool Application.OrganizerCopy. Sorry, that's only in Word..

Upvotes: 0

SierraOscar
SierraOscar

Reputation: 17637

macroCopyTestBook.xlsx should be Workbooks("macroCopyTestBook").VBProject
and
PERSONAL.XLSB should be Workbooks("PERSONAL.XLSB").VBProject


So your function should look something like:

CopyModule("copyThisModule", Workbooks("macroCopyTestBook.xlsx").VBProject, Workbooks("PERSONAL.XLSB").VBProject, False)

You can't reference a workbook object directly from it's name, so you need to use the Workbooks() method to let VBA know what you are referring to.

Upvotes: 1

Related Questions