2
\$\begingroup\$

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 link and install - 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.

\$\endgroup\$
7
  • \$\begingroup\$ Is this for Malware development? \$\endgroup\$
    – HackSlash
    Apr 25, 2022 at 15:43
  • \$\begingroup\$ @HackSlash Well, in so far as pip install randomInternetPackage is. 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\$
    – Greedo
    Apr 25, 2022 at 17:01
  • \$\begingroup\$ @HackSlash To be clear, it's a good point, and any way to reduce the risk on that front would be nice to know about in a review :) I mention that in the linked python question about the front-end \$\endgroup\$
    – Greedo
    Apr 25, 2022 at 17:03
  • \$\begingroup\$ Package security is hard. It's also evolving state of the art right now. For example, Microsoft is still working on a way to notify you of vulnerabilities in your NuGet packages. Currently, there is no indication that you've imported a critical vulnerability in to your app. It's important to be able to communicate this to all consumers who are dependent upon the code. Especially if the vulnerability was introduced on purpose. \$\endgroup\$
    – HackSlash
    Apr 25, 2022 at 18:20
  • 1
    \$\begingroup\$ For command line parsing you should use CommandLineToArgvW because Everyone quotes command line arguments the wrong way. This is what C/C++ stdlib is using on Windows and so most command line utilities expect de facto. \$\endgroup\$
    – wqw
    Apr 30, 2022 at 6:49

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.