使用 VBA 將 VBA 模塊從 Access 項目導出到 Excel 項目

Question

我的任務是創建一個基於 VBA 的系統，該系統允許我將部門特定的文檔注釋代碼插入到基於 VBA 的程序中，然后稍后提取這些代碼。該程序通過將 2 個 VBA 模塊臨時插入目標項目中來實現這一點，然后運行包含的函數。 這本身就可以正常運行，並且使用 VBA 插入/提取注釋。

但是，我發現自己無法將模塊從基於訪問的插入項目插入到基於 excel 的項目中。 我一直在使用此功能將模塊導入目標訪問項目：

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 傳遞目標項目的文件路徑，programtype 指定我選擇的項目類型。 兩者都設置在外部項目中。

是否有基於 VBA 的解決方案可以讓我：

1. 將CurrentProject.allModules定義的模塊從access導入到目標Excel項目中
   2. 運行后從目標 Excel 項目中刪除模塊

Answer 1

感謝@chrisneilsen 評論中提供的鏈接，我想出了一個解決方案來完成我們的計划。 解決方法是在excel項目中創建一個空白的模塊，然后將位於access模塊​​中的VBE行作為字符串導入到這個新的excel模塊中。

這是代碼片段，以防其他人遇到此問題：

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

移除與訪問非常相似：

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