Ok compiler is a bit of a stretch...
I'm working on a package manager for VBA code, written primarily in python. One fiddly step of the pipeline involves "compiling" packages; this is the process of taking VBA source code (.bas, .cls etc) and stuffing it into addin files for different VBA host apps (Excel .xlam, Access .accdb). I also need to "link" files - make foo.xlam have a reference to bar.xlam and baz.dll.
Originally I had written this compile+link code in python - interacting with the VBA extensibility API to programmatically create files. However python is sloppy when interfacing with COM (which is the framework that VBA and the extensibility API are built upon), often leaving Excel.exe processes hanging around, or other memory leaks. It was then that I realised twinBASIC (tB) had matured enough that I could write a small console app for all this COM interaction, which would be a standalone utility that I could call from python. The result is far nicer, simpler and more idiomatic, and probably a little faster too.
Design Objectives
- Standalone exe as much as possible to make distribution simpler (but can depend on presence of Excel for example).
- Provide help text so that I don't need to refer back to the source code too often.
- Don't bother sanitising/ checking inputs too extensively; until twinBASIC matures it is easier to do this in python and ensure the parameters are all valid at the callsite. Just assume inputs are correct.
- Similarly error reporting is still young in tB so don't lose sleep over this (that said suggestions for easy improvements are welcome)
- Allow compilation of Excel or Access files - keep this abstract so more can be added.
- Target 32/64 bit office, even if exe is only 32 bit (tB free tier).
- Don't go off track and write the perfect CLI tool, the most flexible parser etc. Core functionality is key here.
- Performance is not essential, hopefully the bottleneck will be the VBIDE api and not the calling code.
- Use the standard channels appropriately (stout for results, stderr for logging) so that the programme can be used as part of a processing pipeline.
Usage
Here are some examples of how to use the app from the command line:
To make foo.xlam with a VBA project LibFoo containing the 2 vba modules as source code:
> vivpack compile --target Excel --project LibFoo --filename foo --source C:/file1.bas "C:/file2 with spaces.cls"
To add bar.xlam and baz.dll as references to foo.xlam
> vivpack link --basefile foo.xlam --refs bar.xlam baz.dll
There is help too:
> vivpack --help
Need valid subcommand: [compile | link | --help]
> vivpack compile --help
usage: compile [--help | --target excel/access | --filename str | --project str | --out-dir folder | --source C:/file1.bas C:/file2.cls ...]
> vivpack link --help
usage: link [--help | --basefile str | --refs C:/file1.xlam C:/file2.accdb ...]
(note in all these examples I'm just showing stdout, stderr contains additional logging)
Code
There are 3 sections to the code:
- The command line interface and all the backend that reads to/from the console
- The commands
linkandinstall- each defines a command line parser to turn flags and values into arguments and parameters. - The VBEProviders which wrap the extensibility api and do the interaction with Excel/Access
Console backend
This code is all about parsing the command line. VBA provides the Command() function to return as a String the command line parameters - e.g. if I run vivpack compile --help, then Command() returns "compile --help". This isn't very useful, what we really want is an array of flags and arguments - e.g. Array("compile", "--help").
I've created a function Function argv(Optional cmd As String) As String() that parses the Command() string into an array. There is an additional complexity because filepaths with spaces need to be escaped in quotations e.g.
vivpack compile --source file1.bas "C:/path with/spaces.bas"
-> Array("compile", "--source", "file1.bas", "C:/path with/spaces.bas")
I have accounted for that.
Here is the full code of that file ConsoleBackend/Console.twin:
Private Module Console
Public Function argv(Optional ByVal cmd As String = vbNullString) As String()
Const QUOTE_CHAR As String = """"
Const SPACE_CHAR As String = " "
If cmd = vbNullString Then cmd = Command$
'We need a buffer to hold the argv at the end -
'The largest this could be is the number of spaces splitting the arguments + 1 (fences and gateposts)
'The actual number may be smaller since arguments may be separated by multiple spaces
' and also "escaped strings" can contain additional spaces
'So this is an upper bound, but is more memory efficient than ReDim Preserve'ing multiple times
Dim result() As String
Dim maxPossibleArgCount As Long = CountOfChar(cmd, SPACE_CHAR) + 1
If maxPossibleArgCount < 1 OrElse maxPossibleArgCount > Len(cmd) Then Return Split("")'EMPTY_RESULT 'empty array since no args or all spaces
ReDim result(1 To maxPossibleArgCount) 'upper bound buffer we will redim preserve down once at the end
Dim charIndex As Long
Dim inEscapes As Boolean
Dim leftEdgeIndex As Long = 1
Dim argCount As Long = 0
Dim lastCharWasEscape As Boolean
For charIndex = 1 To Len(cmd)
Select Case Mid$(cmd, charIndex, 1)
Case SPACE_CHAR
'a space after the last " indicates the end of an escaped string
If inEscapes AndAlso lastCharWasEscape Then inEscapes = False
If Not inEscapes Then
If charIndex = leftEdgeIndex Then 'this is another space so just skip over it
leftEdgeIndex += 1
Else
'subtract an additional character if last was an escape close
Dim argLen As Long = charIndex - leftEdgeIndex - IIf(lastCharWasEscape, 1, 0)
argCount += 1
result(argCount) = Mid$(cmd, leftEdgeIndex, argLen)
leftEdgeIndex = charIndex + 1 'skip the space
End If
End If
lastCharWasEscape = False
Case QUOTE_CHAR
If Not inEscapes Then
' entering escapes we want to skip over a character
leftEdgeIndex += 1
inEscapes = True
End If
' leaving escapes we also want to skip a character
' unless that escape is midway in an escaped word "foo""bar" -> foo"bar
' in which case it's escaping a quote char within an escaped phrase rather than ending the escape
lastCharWasEscape = True
Case Else
lastCharWasEscape = False
End Select
Next
If inEscapes AndAlso lastCharWasEscape Then inEscapes = False
If inEscapes Then Err.Raise 5, description:= "Unclosed Escape introduced at position " & leftEdgeIndex - 1
'there may be one arg left if the command doesn't have a space after it
'Although we don't want to capture it if it is only a space which is what this check avoids
If leftEdgeIndex < charIndex Then
argLen = charIndex - leftEdgeIndex - IIf(lastCharWasEscape, 1, 0)
argCount += 1
result(argCount) = Mid$(cmd, leftEdgeIndex, argLen)
leftEdgeIndex = charIndex + 1 'skip the spaces
End If
If argCount = 0 Then Return Split("")
ReDim Preserve result(1 To argCount)
Return result
End Function
Public Static Property Get stdout() As ITextStream
Dim fso As New Scripting.FileSystemObject
Dim result As ITextStream
If result Is Nothing Then Set result = fso.GetStandardStream(Scripting.StdOut)
Return result
End Property
Public Static Property Get stderr() As ITextStream
Dim fso As New Scripting.FileSystemObject
Dim result As ITextStream
If result Is Nothing Then Set result = fso.GetStandardStream(Scripting.StdErr)
Return result
End Property
[ Description ("Outputs both to stderr and the debug window") ]
Public Static Property Get StdDebug() As ITextStream
Dim result As ITextStream
If result Is Nothing Then Set result = New StreamTee(stderr, debugOut)
Return result
End Property
[ Description ("Outputs both to stdout and the debug window") ]
Public Static Property Get StdOutWithTrace() As ITextStream
Dim result As ITextStream
If result Is Nothing Then Set result = New StreamTee(stdout, debugOut)
Return result
End Property
End Module
Public Module Parsers
[ Description ("Parses cmd string into {flag:Collection(args...)} by collecting arguments based on preceding flag, optional first defaultFlag") ]
Public Function CollectingFlagArgumentParser(Optional ByVal cmd As String = vbNullString, Optional ByVal defaultFlag As String = vbNullString) As Dictionary
Return CollectingFlagArgumentParser(argv(cmd), defaultFlag)
End Function
[ Description ("Parses raw argv array into {flag:Collection(args...)}") ]
Public Function CollectingFlagArgumentParser(ByRef argv As String(), Optional ByVal defaultFlag As String = vbNullString) As Dictionary
'TODO: spaces in path
Dim result As Dictionary = New Dictionary
Dim currentFlag As String = defaultFlag
result.Add currentFlag, New Collection
Dim outFlagName As String
Dim i As Long
For i = LBound(argv) To UBound(argv)
stderr.WriteLine "[INFO] Parsing '" & argv(i) & "' ..."
If tryParseAsFlag(argv(i), outFlagName) Then
currentFlag = outFlagName
result.Add currentFlag, New Collection
Else
Dim flagArgs As Collection = result.Item(currentFlag)
flagArgs.Add argv(i)
End If
Next
Return result
End Function
Private Function tryParseAsFlag(ByVal arg As String, ByRef outFlag As String) As Boolean
If Left$(arg, 1) = "-" Then
If Len(arg) >= 3 AndAlso Left$(arg, 3) = "---" Then
Return False
ElseIf Len(arg) >= 2 AndAlso Left$(arg, 2) = "--" Then
outFlag = Right$(arg, Len(arg) - 2) 'captures --flags
Else
outFlag = Right$(arg, Len(arg) - 1) 'captures -f or -foo flags
End If
Return True
End If
Return False
End Function
End Module
Private Module ConsoleStringUtils
Public Function CountOfChar(ByVal searchWithin As String, ByVal substrToFind As String) As Long
'This could be optimised I'm sure
CountOfChar = UBound(Split(searchWithin, substrToFind))
End Function
End Module
I've also made a module Parsers that defines a generic CollectingFlagArgumentParser. All this does is takes the argv which looks like a mixture of --flags and values:
Array("install", "--flag1", "foo", "--xyz", "bar", "baz")
And it turns it into a dictionary where the keys are the --flags and the values are the collection of arguments that follow immediately after it, i.e.
Dictionary{
[no-flag]: Collection("install",)
"flag1": Collection("foo",)
"xyz": Collection("bar", "baz")
}
This is a general way to parse the command line into a slightly more useful structure, but it's not very advanced. I know it could be improved with things like type-checking arguments, specifying number of arguments following each flag etc. see python's fantastic argparse library. However I'm not trying to write an argument parsing library here, I'm sure Wayne will add something better to tB at some point. I wonder if this has been done before in VB6, I couldn't find anything?
For reading to/from the command line, I have ConsoleBackend/StdIO.twin:
[ PredeclaredId ]
Private Class debugOut
Implements Scripting.ITextStream
Private Sub WriteLine(Optional ByVal Text As String = "") Implements Scripting.ITextStream.WriteLine
Debug.Print Text
End Sub
Private Sub Write(ByVal Text As String) Implements Scripting.ITextStream.Write
Debug.Print Text ; 'suppress newline
End Sub
Private Sub WriteBlankLines(ByVal Lines As Long) Implements Scripting.ITextStream.WriteBlankLines
Write String$(Lines, vbNewLine)
End Sub
End Class
Private Class StringBufferOut
Implements Scripting.ITextStream
Private buff As String 'TODO: use StringBuilder
Public Property Get ToString() As String
Return buff
End Property
Private Sub Write(ByVal Text As String) Implements Scripting.ITextStream.Write
buff = buff & Text
End Sub
Private Sub WriteLine(Optional ByVal Text As String = "") Implements Scripting.ITextStream.WriteLine
buff = buff & (Text & vbNewLine) 'evaluate in this order requires fewer string copies
End Sub
Private Sub WriteBlankLines(ByVal Lines As Long) Implements Scripting.ITextStream.WriteBlankLines
Write String$(Lines, vbNewLine)
End Sub
End Class
Private Class StreamTee
Implements ITextStream
Public ReadOnly leftStream As ITextStream
Public ReadOnly rightStream As ITextStream
Sub New(ByVal leftValue As ITextStream, ByVal rightValue As ITextStream)
Set leftStream = leftValue
Set rightStream = rightValue
End Sub
Private Sub Write(ByVal Text As String) Implements Scripting.ITextStream.Write
leftStream.Write Text
rightStream.Write Text
End Sub
Private Sub WriteBlankLines(ByVal Lines As Long) Implements Scripting.ITextStream.WriteBlankLines
leftStream.WriteBlankLines Lines
rightStream.WriteBlankLines Lines
End Sub
Private Sub WriteLine(Optional ByVal Text As String = "") Implements Scripting.ITextStream.WriteLine
leftStream.WriteLine Text
rightStream.WriteLine Text
End Sub
End Class
I love tB's class constructors ;) New StreamTee(stream1, stream2) duplicates the calls over two ITextStreams. I use it to log to debug window when programming, a string buffer when testing, and the console when finished.
Commands and CLI parsers
So from the console backend we have a dictionary of collections, where each collection corresponds to the arguments that follow a flag. Now each command has a certain signature, so it is responsible for reading the dictionary and interpreting and parsing it further into a structure specific to that command. This is done in CLIParser.twin:
Private Module CLI
Public Const ADDREF_COMMAND_TEXT As String = "link"
Public Const COMPILE_COMMAND_TEXT As String = "compile"
Public Type CLIArgs
isCompileCommand As boolean
inHelpMode As boolean
refCommand As ReferenceAdderArgs
compileCommand As AddinCompilerArgs
End Type
Public Const COMMAND_FLAG As String = ""
Public Const HELP_FLAG As String = "help"
Public Type ReferenceAdderArgs
isExcelTarget As Boolean
inHelpMode As boolean
baseFile As String
references As Collection
End Type
Public Const BASE_FILE_FLAG As String = "basefile"
Public Const REFERENCES_FLAG As String = "refs"
Public Type AddinCompilerArgs
isExcelTarget As Boolean
inHelpMode As boolean
files As Collection
projectName As String
saveDir As IFolder
fileNameNoExt As String
End Type
Public Const PROJ_FLAG As String = "project"
Public Const SAVE_DIR_FLAG As String = "out-dir"
Public Const SAVE_FILE_FLAG As String = "filename"
Public Const SOURCE_FILES_FLAG As String = "source"
Public Const TARGET_FLAG As String = "target"
Public Function parseArgs(Optional ByVal cmd As String = vbNullString) As CLIArgs
StdDebug.WriteLine "[DEBUG] Parsing Args"
Return parseArgs(argv(cmd))
End Function
Public Function parseArgs(ByRef argv As String()) As CLIArgs
'mark source flag as first positional only
Dim collectedArgs As Dictionary = CollectingFlagArgumentParser(argv, COMMAND_FLAG)
dumpFlagDict collectedArgs, StdDebug
Dim result As CLIArgs
Dim commandArgs As Collection = dictGet(collectedArgs, COMMAND_FLAG, flagValues("help"))
If commandArgs.Count <> 1 Then
StdDebug.WriteLine "[ERROR] exactly 1 sub-command must be passed"
result.inHelpMode = True
Return result
End If
Select Case LCase$(commandArgs(1))
Case COMPILE_COMMAND_TEXT
result.isCompileCommand = True
result.compileCommand = parseCompileCommandArgs(collectedArgs)
Case ADDREF_COMMAND_TEXT
result.isCompileCommand = False
result.refCommand = parseAddRefCommandArgs(collectedArgs)
Case Else
result.inHelpMode = True
End Select
Return result
End Function
Private Function parseAddRefCommandArgs(ByVal collectedArgs As Dictionary) As ReferenceAdderArgs
Static fso As New FileSystemObject
Dim result As ReferenceAdderArgs
If collectedArgs.Exists(HELP_FLAG) Then
result.inHelpMode = True
Return result
End If
StdDebug.WriteLine printf("[DEBUG] Reading {} command arg values", ADDREF_COMMAND_TEXT)
With result
Dim baseFileNameArgs As Collection = dictGet(collectedArgs, BASE_FILE_FLAG, flagValues())
If baseFileNameArgs.Count = 1 Then
.baseFile = baseFileNameArgs(1)
StdDebug.WriteLine "[INFO] basefile = " & .baseFile
Else
.inHelpMode = True 'there must be a basefile to add refs to
StdDebug.WriteLine "[ERROR] exactly 1 basefile must be passed"
Return result
End If
.inHelpMode = False
StdDebug.WriteLine "[INFO] inHelpMode = " & .inHelpMode
'use extension of target file to determine the target application
Select Case fso.GetExtensionName(.baseFile)
Case "xlsm", "xlam"
.isExcelTarget = True
Case Else:
.isExcelTarget = False
End Select
StdDebug.WriteLine "[INFO] targetting Excel = " & .isExcelTarget
Set .references = dictGet(collectedArgs, REFERENCES_FLAG, flagValues())
StdDebug.WriteLine "[INFO] refs to add = " & .references.Count
End With
StdDebug.WriteLine "[INFO] Arg values read"
Return result
End Function
Private Function parseCompileCommandArgs(ByVal collectedArgs As Dictionary) As AddinCompilerArgs
Static fso As New FileSystemObject
Dim result As AddinCompilerArgs
If collectedArgs.Exists(HELP_FLAG) Then
result.inHelpMode = True
Return result
End If
StdDebug.WriteLine printf("[DEBUG] Reading {} command arg values", COMPILE_COMMAND_TEXT)
Dim tempFolder As String = Environ$("Temp")
With result
.inHelpMode = False
StdDebug.WriteLine "[INFO] inHelpMode = " & .inHelpMode
Dim targetArgs As Collection = dictGet(collectedArgs, TARGET_FLAG, flagValues("excel"))
.isExcelTarget = LCase$(targetArgs(1)) = "excel"
StdDebug.WriteLine "[INFO] targetting Excel = " & .isExcelTarget
Set .files = dictGet(collectedArgs, SOURCE_FILES_FLAG, flagValues())
StdDebug.WriteLine "[INFO] files = " & .files.Count
Dim foderNameArgs As Collection = dictGet(collectedArgs, SAVE_DIR_FLAG, flagValues(tempFolder))
Set .saveDir = fso.GetFolder(foderNameArgs(1))
StdDebug.WriteLine "[INFO] saveDir = " & .saveDir.Path
Dim projectNameArgs As Collection = dictGet(collectedArgs, PROJ_FLAG, flagValues("fooProj")) 'array since we want first value from collection
.projectName = projectNameArgs(1)
StdDebug.WriteLine "[INFO] projectName = " & .projectName
Dim fileNameArgs As Collection = dictGet(collectedArgs, SAVE_FILE_FLAG, flagValues("fooFile"))
.fileNameNoExt = fileNameArgs(1)
StdDebug.WriteLine "[INFO] filename = " & .fileNameNoExt
End With
StdDebug.WriteLine "[INFO] Arg values read"
Return result
End Function
Function flagValues(ParamArray values() As Variant) As Collection
Dim result As New Collection
Dim value As Variant
For Each value In values
result.Add value
Next value
Return result
End Function
End Module
Private Module ParserUtils
Public Sub dumpFlagDict(ByVal dict As Dictionary, Optional ByVal stream As ITextStream)
If stream Is Nothing Then Set stream = debugOut
Dim flag As Variant
For Each flag In dict.Keys()
Dim flagInfo As Collection = dict(flag)
stream.WriteLine "Flag: " & flag
Dim argValue As Variant
For Each argValue In flagInfo
stream.WriteLine vbTab & argValue
Next
Next
End Sub
Public Function dictGet(ByVal dict As Dictionary, ByRef key As Variant, ByVal default As Variant) As Variant
Return If(dict.Exists(key), dict(key), default)
End Function
End Module
There are three public types corresponding to the implicit main command and the two subcommands compile,link. There are two parse...Args() corresponding to each subcommand. (Note for legacy reasons, the "link" command used to be called "addref" - unfortunately the current tB IDE doesn't have refactor->rename support so I had to leave them like that)
The argument structures are used by the commands in Commands.twin. e.g.
Public Function compileCommand(ByRef args As AddinCompilerArgs) As String
... takes an AddinCompilerArgs UDT and returns the path to the compiled file.
Here's the code for all the commands including their help text:
Module Commands
Public Sub printHelp()
'help goes to stdout since it is the output of this command
StdOutWithTrace.WriteLine printf("Need valid subcommand: [{} | {} | --help]", COMPILE_COMMAND_TEXT, ADDREF_COMMAND_TEXT)
End Sub
Public Sub printCompileCommandHelp()
'NOTE use printf so we use the actual flag tokens recognised by the parser
StdOutWithTrace.WriteLine _
printf( _
"usage: {} [--{} | --{} excel/access | --{} str | --{} str | --{} folder | --{} C:/file1.bas C:/file2.cls ...]", _
CLI.COMPILE_COMMAND_TEXT, CLI.HELP_FLAG, CLI.TARGET_FLAG, CLI.SAVE_FILE_FLAG, CLI.PROJ_FLAG, CLI.SAVE_DIR_FLAG, CLI.SOURCE_FILES_FLAG _
)
End Sub
Public Function compileCommand(ByRef args As AddinCompilerArgs) As String
If args.inHelpMode Then
printCompileCommandHelp
Exit Function
End If
Dim compiler As IAddinCompiler
If args.isExcelTarget Then
With New ExcelContext
Set compiler = New ExcelAddinCompiler(.app)
Return VBEStuff.compileProject(compiler, args) 'I don't think this can safely come out of the with block
End With
Else
Set compiler = New AccessAllInOneProvider
Return VBEStuff.compileProject(compiler, args)
End If
End Function
Public Sub printAddRefCommandHelp()
StdOutWithTrace.WriteLine _
printf( _
"usage: {} [--{} | --{} str | --{} C:/file1.xlam C:/file2.accdb ...]", _
CLI.ADDREF_COMMAND_TEXT, CLI.HELP_FLAG, CLI.BASE_FILE_FLAG, CLI.REFERENCES_FLAG _
)
End Sub
Public Sub addRefCommand(ByRef args As ReferenceAdderArgs)
If args.inHelpMode Then
printAddRefCommandHelp
Exit Sub
End If
Static fso As New Scripting.FileSystemObject
Dim fullPath As String = fso.GetAbsolutePathName(args.baseFile)
StdDebug.WriteLine printf("[DEBUG] full path is '{}'", fullPath)
Dim compiler As IAddinCompiler
If args.isExcelTarget Then
With New ExcelContext
Set compiler = New ExcelAddinCompiler(.app)
VBEStuff.addReferences compiler.GetAddin(fullPath), args.references
End With
Else
Set compiler = New AccessAllInOneProvider
VBEStuff.addReferences compiler.GetAddin(fullPath), args.references
End If
End Sub
End Module
Private Module VBEStuff
[ Description ("Programatically add files as VBA references to the base file") ]
Public Sub addReferences(ByVal baseHandle As IReferenceHandle, ByVal references As Collection)
Static fso As New Scripting.FileSystemObject
Dim reference As Variant
For Each reference In references
Dim fullPath As String = fso.GetAbsolutePathName(reference)
StdDebug.WriteLine printf("[INFO] Successfully added reference: '{}'", _
baseHandle.projectHandle.References.AddFromFile(fullPath).Name)
Next reference
End Sub
Public Function compileProject(ByVal compiler As IAddinCompiler, ByRef args As AddinCompilerArgs) As String
With compiler.MakeAddin(args.saveDir.Path, args.fileNameNoExt)
StdDebug.WriteLine "Saving to: " & .referencePath
populateProject .projectHandle, args.projectName, args.files
Return .referencePath
End With
End Function
Public Sub populateProject(ByVal projHandle As VBIDE.VBProject, ByVal projectName As String, ByVal files As Collection)
Static fso As New Scripting.FileSystemObject
With projHandle
.Name = projectName
Dim filePath As Variant
For Each filePath In files
Dim fullPath As String = fso.GetAbsolutePathName(filePath)
If Not fso.FileExists(fullPath) Then
StdDebug.WriteLine "[Error] File does not exist: " & fullPath
Exit Sub
End If
StdDebug.WriteLine "[INFO] Attempting to add: " & fullPath
.VBComponents.Import fullPath
Next filePath
End With
End Sub
End Module
Note the help text is populated by parameters coming from the CLIParsers file. This ensures they remain in sync, in case I ever rename a flag in the command's argument parser, the help text should update accordingly.
The Main.twin entry point is then simply:
Module MainModule
' This project type is set to 'Standard EXE' in the Settings file, so you need a Main() subroutine to run when the EXE is started.
Public Sub Main()
'used only when running in the ide for testing
Const CMDSTR As String = "link --basefile foo.xlsm"'
Main CStr(If(InIDE, CMDSTR, vbNullString))
End Sub
Public Sub Main(ByVal cmd As String) 'importable version for other tB projects
Dim args As CLIArgs = CLI.parseArgs(cmd)
If args.inHelpMode Then
Commands.printHelp
ElseIf args.isCompileCommand Then
Dim createdFile As String = Commands.compileCommand(args.compileCommand)
stdout.Write createdFile '"return value" goes to stdout
Else
Commands.addRefCommand args.refCommand
End If
End Sub
End Module
Private Module TestingUtils
Private ideCheck As Boolean
Public Property Get InIDE() As Boolean
Debug.Assert (IsInIDE())
InIDE = ideCheck
End Property
Private Function IsInIDE() As Boolean
ideCheck = True
IsInIDE = ideCheck
End Function
End Module
VBE interaction
Finally, the actual functionality of interacting with files and constructing them programmatically is done in an OOP way. I have the abstract VBEProvider/VBEProviders.twin file defining two interfaces:
Private Class IReferenceHandle
Public Property Get projectHandle() As VBIDE.VBProject
End Property
Public Property Get referencePath() As String
End Property
End Class
Private Class IAddinCompiler
[ Description ("Creates an addin file at a certain location and returns its handle") ]
Public Function MakeAddin(ByVal saveDir As String, ByVal fileName As String) As IReferenceHandle
End Function
[ Description ("Opens the addin file at the specified location") ]
Public Function GetAddin(ByVal referencePath As String) As IReferenceHandle
End Function
End Class
... basically allowing me to treat Excel.Application or Access.Application both as "things that can create a document (accdb, xlam) and expose a handle to that document's VBA project" as well as a path that can be used in the linker proj.AddReferenceFromFile(pathToAnotherDocument).
I have two concrete implementations; an Excel and an Access version. Why only these two, when VBA runs in many other hosts? Well as far as I know, Excel and Access are the only host apps that allow you to create a vba document and add a reference to it from another one. So for the purposes of my package manager, which operates on this principle, those are the only valid hosts for now. They do make up the majority of VBA users though, I believe.
Anyway here's the Excel one in VBEProvider/ExcelVBEProvider.twin:
Private Class AutosaveExcelFile
Implements IReferenceHandle
Private ReadOnly wrappedFile As Excel.Workbook
Private Sub New(ByVal addinFile As Excel.Workbook)
If Not addinFile.Saved() OrElse Not addinFile.IsAddin Then
Err.Raise 5, description:= "The supplied file must be an addin saved locally"
End If
Set wrappedFile = addinFile
End Sub
Private Property Get projectHandle() As VBProject Implements IReferenceHandle.projectHandle
Return wrappedFile.VBProject
End Property
Private Property Get referencePath() As String Implements IReferenceHandle.referencePath
Return wrappedFile.FullName
End Property
Private Sub Class_Terminate()
wrappedFile.Close True
End Sub
End Class
Private Class ExcelAddinCompiler
Implements IAddinCompiler
Private ReadOnly parentApp As Excel.Application
Sub New(ByVal app As Excel.Application)
Set parentApp = app
End Sub
Private Function MakeAddin(ByVal saveDir As String, ByVal fileName As String) As IReferenceHandle Implements IAddinCompiler.MakeAddin
Dim saveFile As String = fileName & ".xlam"
With parentApp
Dim savePath As String = saveDir & .PathSeparator & saveFile
Dim book As Excel.Workbook = .Workbooks.Add
book.SaveAs savePath, XlFileFormat.xlOpenXMLAddIn
book.Close False
Set book = .Workbooks.Open(savePath) 'I don't know why we need to close and reopen here but we do
End With
Return New AutosaveExcelFile(book)
End Function
Private Function GetAddin(ByVal referencePath As String) As IReferenceHandle Implements IAddinCompiler.GetAddin
With parentApp
Dim book As Excel.Workbook = .Workbooks.Open(referencePath)
End With
Return New AutosaveExcelFile(book)
End Function
End Class
Public Class ExcelContext
Public ReadOnly app As Excel.Application
Private Function NewApp() As Excel.Application
Set NewApp = New Application
With NewApp
.Visible = False
.PrintCommunication = False
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Interactive = False
End With
End Function
[ Description ("Context manager for an excel instance so its lifetime is managed by With statement") ]
Private Sub Class_Initialize()
Set app = NewApp
End Sub
Private Sub Class_Terminate()
If app Is Nothing Then Exit Sub
Dim book As Excel.Workbook
For Each book In app.Workbooks
book.Close False
Next book
app.Quit
End Sub
End Class
and here is the Access one VBEProvider/AccessVBEProvider.twin:
Public Class AccessAllInOneProvider
Implements IReferenceHandle
Implements IAddinCompiler
Private ReadOnly parentApp As Access.Application
Private Sub Class_Initialize()
Set parentApp = New Access.Application
End Sub
Private Property Get projectHandle() As VBProject Implements IReferenceHandle.projectHandle
Return parentApp.VBE.ActiveVBProject
End Property
Private Property Get referencePath() As String Implements IReferenceHandle.referencePath
Return parentApp.CurrentDb.Name
End Property
Private Function MakeAddin(ByVal saveDir As String, ByVal fileName As String) As IReferenceHandle Implements IAddinCompiler.MakeAddin
Static fso As New Scripting.FileSystemObject
Dim saveFile As String = fso.BuildPath(saveDir, fileName & ".accdb")
If fso.FileExists(saveFile) Then fso.DeleteFile saveFile, force:=True
parentApp.DBEngine.CreateDatabase saveFile, DB_LANG_GENERAL
parentApp.OpenCurrentDatabase saveFile
Return Me
End Function
Private Function GetAddin(ByVal referencePath As String) As IReferenceHandle Implements IAddinCompiler.GetAddin
parentApp.OpenCurrentDatabase referencePath
Return Me
End Function
Private Sub Class_Terminate()
If parentApp Is Nothing Then Exit Sub
parentApp.DoCmd.RunCommand acCmdCompileAndSaveAllModules
parentApp.DoCmd.Quit acQuitSaveAll
End Sub
End Class
I like the Excel one more, because it says that:
- Excel.Application is an
IAddinProvider- creating or opening VBA enabled files - Excel.Workbook is the
IReferenceHandle- giving access to the VBE
I'm not nearly as familiar with Access' object model, so I've had to make a single AccessAllInOneProvider which acts as both the provider and reference handle. This is because I can't work out how to reach the VBE from an accdb file, only from the entire Application. Suggestions and edge-case fixes here would be very welcome!
[Invoking from python]
For context, this is how I'm calling it from python using the subprocess module (not for review):
"""
Created on Mon Apr 18 11:27:00 2022
Module for invoking vivpack
"""
import enum
import subprocess
from pathlib import Path
from typing import Any
from typing import Optional
from viv.mytypes import AnyPath
from viv.resources import get_vivpack
class COMPILE_TARGET(enum.Enum):
EXCEL = "excel"
ACCESS = "access"
# check_call(cmd: Sequence[str], ... stdout: int = ..., stderr: ...
def _check_call(*cmd: AnyPath, **kwargs: Any) -> None:
subprocess.check_call(cmd, **kwargs)
def _check_output(*cmd: AnyPath, **kwargs: Any) -> str:
return subprocess.check_output(cmd, **kwargs, text=True)
def compile_help() -> str:
with get_vivpack() as exe:
return _check_output(exe, "compile", "--help", stderr=subprocess.DEVNULL)
def link_help() -> str:
with get_vivpack() as exe:
return _check_output(exe, "link", "--help", stderr=subprocess.DEVNULL)
def create_addin(
exe: Path,
*vba_sources: AnyPath,
output_dir: Optional[AnyPath] = None,
filename: Optional[str] = None,
project_name: Optional[str] = None,
target: Optional[COMPILE_TARGET] = None,
) -> Path:
options = {
"--filename": filename,
"--project": project_name,
"--target": target.value if target else None,
"--out-dir": output_dir,
}
filtered_options = {k: v for k, v in options.items() if v}
option_list: list[AnyPath] = []
for pair in filtered_options.items():
option_list.extend(pair)
if vba_sources:
option_list.extend(("--source", *vba_sources))
output = _check_output(
exe,
"compile",
*option_list,
stderr=subprocess.DEVNULL, # makes sure we only get the "return value"
)
return Path(output)
def link_refs(
exe: Path,
basefile: AnyPath,
*ref_files: AnyPath,
) -> None:
option_list: list[AnyPath] = []
if ref_files:
option_list.extend(("--refs", *ref_files))
_check_call(
exe,
"link",
"--basefile",
basefile,
*option_list,
)
def main():
print(compile_help())
print(link_help())
with get_vivpack() as exe:
print(f"{exe = !s}")
addin = create_addin(exe, filename="packaging_test")
print(f"{addin = !s}")
addin.unlink()
assert not addin.exists(), "It's still there!!!"
return 0
if __name__ == "__main__":
raise SystemExit(main())
Download
Here's a downloadable zip containing the .twinproj source code, as well as a compiled .exe (let's see how distributable it really is! Seems to work on a second computer, with antivirus whitelisting*)
*To clarify: that is whitelisting of the vivpack.exe (since it is not signed or downloaded by many people), not of the documents it creates. Never trust the document created from arbitrary untrusted source code.
pip install randomInternetPackageis. The goal isn't malware distribution, rather to help improve the VBA ecosystem and let people share their code and build something great on top of each other's work! It will hopefully benefit everyone (including malware authors, although they are not the target demographic). \$\endgroup\$