Importing Excel Macros Code from another Excel sheet which has Macro code.

**arun.pillai** · 01-14-2010, 03:39 AM

How can I Export and import Excel Macro from an Excel Template in Centralized location? Whenever user opens the Template this code gets imported at runtime.

All macro code in file1 kept in Shared drive.

Whenever any user opens Template it gets all the code for macro from this Shared Drive --> template.

For that I need to have some code within all the templates to get this code from shared drive.

i) Importing macros

ii) have all code in VBS format in the shared drive

But for First solution it not working. I will show you what I have worked on and could you please tell me what is wrong.

Please find the code which i have worked on however has issues with it when import line is execute. It doesn't perform any action though it executes that line.

Private Sub Workbook_Open()
'Call Sheet1.updatescreens
Call OpenSourceExcel
Call CopyMacroModule(Workbooks("Smoke_Test.xls"), "Test Script")
'Call CopyMacroModule(Workbooks("Smoke_Test.xls"), "Result")
'Call CopyMacroModule(Workbooks("Smoke_Test.xls"), "Datapool")
'Call CopyMacroModule(Workbooks("Smoke_Test.xls"), "Object Repository")
Call CloseSourceExcel
End Sub

Sub CopyMacroModule(SourceWB As Workbook, strModuleName As String)
strFolder = SourceWB.Path
arun = ThisWorkbook.Path
arun1 = ThisWorkbook.Name
Set Targetwb = ThisWorkbook
MsgBox arun1
temp = arun & "\" & arun1
MsgBox temp
If Len(strFolder) = 0 Then strFolder = CurDir
strFolder = strFolder & "\"
strTempFile = strFolder & "tmpexport.bas"
MsgBox strFolder
SourceWB.VBProject.VBComponents(1).Export (strTempFile)
MsgBox ActiveWorkbook.Name
Targetwb.VBProject.VBComponents.Import (strTempFile)
ThisWorkbook.AcceptAllChanges
ThisWorkbook.Save
Kill strTempFile
End Sub


Private Sub OpenSourceExcel()
strSourceSheet = "C:\Smoke_Test.xls"
Set objExcelSource = CreateObject("Excel.Application")
Set objSpreadSource = objExcelSource.Workbooks.Open(strSourceSheet)
End Sub
Private Sub CloseSourceExcel()
objExcelSource.Workbooks.Close
End Sub

**PMO** · 01-14-2010, 05:38 PM

Hello,

A track with the following code to copy in the code window ThisWorkbook

'### Adapt the constants ###
Const MY_WORKBOOK_SOURCE As String = "Smoke_Test.xls"
Const MY_DIR_SOURCE As String = "C:\"
'###########################

Dim objExcelSource As Workbook

Private Sub Workbook_Open()
Dim var
Set objExcelSource = GetObject(MY_DIR_SOURCE & MY_WORKBOOK_SOURCE)

          '°°° WARNING : No space in the module's name °°°
'--- To import one module ---
var = Array("TestScript")
'--- To import several modules ---
'var = Array("Result", "Datapool", "ObjectRepository")

Call CopyMacroModule(objExcelSource, var)
End Sub

Sub CopyMacroModule(SourceWB As Workbook, ModulesNames As Variant)
Dim Targetwb As Workbook
Dim strFolder As String
Dim strTempFile As String
Dim i&
Dim fso As Object
On Error GoTo PseudoErreur
If Not IsArray(ModulesNames) Then
  Error 65000
End If
Set Targetwb = ThisWorkbook
strFolder = SourceWB.Path
If Len(strFolder) = 0 Then strFolder = CurDir
strTempFile = strFolder & "\tmpexport.bas"
For i& = LBound(ModulesNames) To UBound(ModulesNames)
  SourceWB.VBProject.VBComponents(ModulesNames(i&)).Export (strTempFile)
  Targetwb.VBProject.VBComponents.Import (strTempFile)
Next i&
ThisWorkbook.Save
PseudoErreur:
If strTempFile <> "" Then
  Set fso = CreateObject("Scripting.Filesystemobject")
  MsgBox fso.FileExists(strTempFile)
  If fso.FileExists(strTempFile) = True Then Kill strTempFile
  Set fso = Nothing
End If
If Not objExcelSource Is Nothing Then
  objExcelSource.Close
  Set objExcelSource = Nothing
End If
If Err <> 0 Then
  If Err = 65000 Then
    MsgBox "ModulesNames The argument ''ModulesNames '' should be an array." & vbCrLf & _
        "ex :  var = Array(''TestScript'') OR var = Array(''Result'', ''Datapool'', ''ObjectRepository'')"
  Else
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description
  End If
End If
End Sub

I put an attachment for better understanding.
It will save Smoke_Test.xls in C: \

Best regards.

PMO
Patrick Morange