使用 VBA 将 VBA 模块从 Access 项目导出到 Excel 项目

Question

I've been tasked with creating a VBA based system that will allow me to insert department specific documentation comment codes into a VBA based program and then later extract these later date.The program does this by temporarily inserting 2 VBA modules into the target project and then running the contained functions. This on it's own functions properly and the comments are inserted/extracted using VBA.

However I find myself at a loss for inserting the modules into an excel based project from my access based insertion project. I've been importing the module to the targeted access project using this function:

Public Function InsertVADER(strTestPath As String, ProgramType As String) As Boolean
'//Insert VADER into the target program
On Error GoTo errjordan

Dim obj As AccessObject '//Create instance of Access Application object.

If ProgramType = "Access" Then


    ''//Transfer Modules to target project.

    For Each obj In CurrentProject.AllModules
       DoCmd.TransferDatabase acExport, "Microsoft Access", strTestPath, acModule, obj.Name, obj.Name & "_TMP", False
    Next obj

    '//Set and open target project
    Set appAccess = CreateObject("Access.Application")
    appAccess.OpenCurrentDatabase strTestPath, False

    '//SEt to visible. If the project has an auto exec that will usurp this project. You will
    appAccess.Visible = True


    '//Open the vader module. If there is an auto run macro this will cause it to show
    appAccess.DoCmd.OpenModule ("VADER_TMP")
ElseIf ProgramType = "Excel" Then
    '//Run Excel routine
    For Each obj In CurrentProject.AllModules
       'DoCmd.TransferDatabase acExport, "Microsoft Excel", strTestPath, acModule, obj.Name, obj.Name & "_TMP", False

    Next obj





End If


'//Indicate function sucess
InsertVADER = True

Exit Function   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
errjordan:

If Err.Number = 2501 Then
    MsgBox "Project cannot be locked for viewing. Please unlock and save project before using this tool"
    Err.Clear
    InsertVADER = False
ElseIf Err.Number = 29045 Or Err.Number = 7866 Then
    MsgBox "This file is not compatible with VADER. Please convert the project to a useable format before using this tool."
    Err.Clear
    InsertVADER = False
Else
    Err.Raise Err.Number
End If


End Function

StrtestPath passes the file path of the target project and programtype specifies what kind of project I've selected. Both are set in an external project.

Is there a VBA based solution that will allow me to:

1. Import the modules defined by the CurrentProject.allModules into the targeted Excel project from access
   2. Remove the modules from the target Excel Project once run

Answer 1

Thanks to the link provided by in the comment @chrisneilsen I have come up with a solution that accomplishes what we have set out to do. The solution is to create a module that is blank in the excel project and then import the VBE lines located in the access module to this new excel module as a string.

Here's a snippet of the code in case anyone else runs into this:

Dim vbProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim codemod As VBIDE.CodeModule

Public Function InsertVADER(strTargetPath As String, ProgramType As String, strRunFunction As String) As Boolean
if programtype = "Excel" then
    '//Run Excel routine. This version is slightly more complex as the module cannot be transfered from Access to excel as a singluar object

    '//Create an instance of an Excel application object
    Set appExcel = CreateObject("Excel.Application")

    '//Open the target workbook
    appExcel.workbooks.Open (strTargetPath)
    appExcel.Visible = True

    '//If there is an on load item for excel then it will need
    Set vbProj = appExcel.ActiveWorkbook.VBProject

RetryEX:        '//If the project is locked you will exit the error capture here for excel


    Debug.Print appExcel.VBE.VBProjects(1).VBComponents.Count

    '//Add modules to the excel project
    Set VBComp = vbProj.VBComponents.Add(vbext_ct_StdModule)
        VBComp.Name = "VADER_TMP"

    Set VBComp = vbProj.VBComponents("VADER_TMP")
    Set codemod = VBComp.CodeModule

    '//Capture the code in the VADER modules located in this project
    Dim strVADER As String

    LoopCount = 1
    lngLineCount = 1
    Do Until lngLineCount > Application.VBE.VBProjects(1).VBComponents("VADER").CodeModule.CountOfLines
        strVADER = strVADER & Application.VBE.VBProjects(1).VBComponents("VADER").CodeModule.Lines(lngLineCount, 1) & vbNewLine

        lngLineCount = lngLineCount + 1
    Loop

    '//Insert the captured VADER code into the Excel module
    codemod.InsertLines 1, strVADER

    '//Do the same thing with runVADER
    Set VBComp = vbProj.VBComponents.Add(vbext_ct_StdModule)
        VBComp.Name = "runVADER_TMP"

    Set VBComp = vbProj.VBComponents("runVADER_TMP")
    Set codemod = VBComp.CodeModule

    strVADER = vbNullString
    LoopCount = 1
    lngLineCount = 1
    Do Until lngLineCount > Application.VBE.VBProjects(1).VBComponents("runVADER").CodeModule.CountOfLines
        strVADER = strVADER & Application.VBE.VBProjects(1).VBComponents("runVADER").CodeModule.Lines(lngLineCount, 1) & vbNewLine

        lngLineCount = lngLineCount + 1
    Loop

    codemod.InsertLines 1, strVADER

    '//Call the function
    appExcel.Run strRunFunction

End If


'//Indicate function sucess
InsertVADER = True

Exit Function   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
errjordan:

'//Captured error

If Err.Number = 2501 Then
    '//An access project locked for viewing
    MsgBox "Project cannot be locked for viewing. Please unlock the project and then press OK."
    Err.Clear
    Resume Next

ElseIf Err.Number = 50289 Then
    '//An excel document locked for viewing
    MsgBox "Workbook cannot be locked for viewing. Please unlock the project and then press OK."
    Err.Clear
    GoTo RetryEX

ElseIf Err.Number = 29045 Or Err.Number = 7866 Then
    '//Not excel or access
    MsgBox "This file is not compatible with VADER. Please convert the project to a useable format before using this tool."
    Err.Clear
Else
    '//Some other error!
    Err.Raise Err.Number
End If

InsertVADER = False '//If I'm here pass a failure code

End Function

Removal remains very similar to that of access:

Public Function RemoveVADER(strTargetPath As String, ProgramType As String)
'//Remove VADER from the project
    '//Target path is not used in the function but has been left in in case of future issues/expandability

If ProgramType = "Access" Then
    Set vbcom = appAccess.VBE.ActiveVBProject.VBComponents
    vbcom.Remove VBComponent:=vbcom.Item("VADER_TMP")
    vbcom.Remove VBComponent:=vbcom.Item("runVADER_TMP")

    '//Close the target program and save changes
    appAccess.Quit acQuitSaveAll

ElseIf ProgramType = "Excel" Then
    Set vbProj = appExcel.ActiveWorkbook.VBProject
    Set VBComp = vbProj.VBComponents("VADER_TMP")
    vbProj.VBComponents.Remove VBComp
    Set VBComp = vbProj.VBComponents("runVADER_TMP")
    vbProj.VBComponents.Remove VBComp

    '//Close the target program and save changes
    appExcel.ActiveWorkbook.Save
    appExcel.Quit
End If

End Function