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:
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.