我的任务是创建一个基于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的解决方案允许我：
答案 0 :(得分：0)
感谢@chrisneilsen评论中提供的链接，我提出了一个解决方案，可以完成我们的目标。解决方案是在excel项目中创建一个空白的模块，然后将位于访问模块中的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