Port VBA to… (JavaScript, C++, Python)

An ongoing project we have on mind is to have a kind-of VBA port-language software, with the ultimately goal to get VBA code compiled, if this is anyway possible, to COM or DLL so code will be effectively hidden from prying eyes. There are some steps that have to be achieved in this process before getting the port:

1. Recognize special or reserved words
2. Set reserved words equivalences to other programming language
3. Detect procedures (Sub/Functions) and its variables
4. Detect objects (Type)
5. Detect enumeration variables (Enum)
6. Structure code in blocks (DoLoop, ForNext, IfThen…) that can be indepedent one from each other
7. Indent code (for better readability and comprenhension)
8. Port from VBA to new language
9. Revise code for unhandled exceptions

From here on, there is a high chance to get code compiled and reuse over Excel through VBA without exposing original code. So, other popular scripting languages, aside VBA, are Python, JavaScript and PHP, all of them had been already wrapped to run under Excel. Other languages considered, as they already have their own compiler, are C++, the collection on .Net platform, and Fortran, so their compiled DLLs can be used with Excel. If language port can be done to any one of those, then, it can be achived for them all.

---

VBA to JavaScript converter

My main interest now is focused in learning JS, and get the port from VBA to JavaScript. One site that game me some hints on how to start on the JS world came from here. The converter scripts are far from running, but the map to follow the conversions is compact and, somehow, clear. There are some functions in VBA but not in JS, so here comes very handy the collecting work done in this CodeProject article by Anele ‘Mashy’ Mbanga. Are these sites worth looking?, seems yes

• http://jsil.org/
• https://www.codeproject.com/Articles/25069/JSBasic-A-BASIC-to-JavaScript-Compiler
• http://jsc.sourceforge.net/

I started with the IF (elseif, else) block, then jumped to the FOR (for each) block, and ended with the LOOP (Do-While/Until, While-Wend) block. Let’s see the code:

Public Sub sV2J_If()
    Dim CodeBlock As String

    'CodeBlock = "If Condition1 = 1 Then If Condition2 = 2 Then If Condition3 = 3 Then Action: If Condition4 = 3 Then Action" & vbLf & _
                "If Condition1 = 1 Then" & vbLf & _
                vbTab & "If Sub1 = 1 Then" & vbLf & _
                vbTab & "   sub1 = 1.1" & vbLf & _
                vbTab & "ElseIf Sub2 = 2 Then" & vbLf & _
                vbTab & "   sub2 = 1.2" & vbLf & _
                vbTab & "ElseIf Sub3 = 3 Then" & vbLf & _
                vbTab & "   sub3 = 1.2" & vbLf & _
                vbTab & "Else" & vbLf & _
                vbTab & "   sub4 = 1.4" & vbLf & _
                vbTab & "End If" & vbLf & _
                "ElseIf Condition2 = 2 Then" & vbLf & _
                "   Statement2 = 2" & vbLf & _
                "ElseIf Condition3 = 3 Then" & vbLf & _
                "   Statement3 = 2" & vbLf & _
                "Else" & vbLf & _
                "   Statement4 = 2" & vbLf & _
                "End If"

    Call fVbCleaner(CodeBlock)

    'CodeBlock = fIf(CodeBlock:=CodeBlock, _
                    Then»:=" Then", _
                    If»:="if ", _
                    ElseIf»:="elseif ", _
                    Else»:="else", _
                    EndIf»:="end if", _
                    Then«:=" {", _
                    If«:="if ", _
                    ElseIf«:="elseif ", _
                    Else«:="else", _
                    EndIf«:="}", _
                    Opener«:=" {", _
                    Closer«:="} ", _
                    Indenter:=" ", _
                    Comment:="'")

    CodeBlock = "For lgCounter1 = LBound(aStatement) To UBound(aStatement)" & vbLf & _
                "   Statement = lgCounter1" & vbLf & _
                "   For lgCounter2 = LBound(aStatement) To UBound(aStatement)" & vbLf & _
                "      Statement = lgCounter2" & vbLf & _
                "      For lgCounter3 = LBound(aStatement) To UBound(aStatement)" & vbLf & _
                "         Statement = lgCounter3" & vbLf & _
                "      Next lgCounter3" & _
                "   Next lgCounter2" & _
                "Next lgCounter1"

    CodeBlock = fFor(CodeBlock:=CodeBlock, _
                     For»:="For ", _
                     Next»:="Next", _
                     Break»:="Exit For", _
                     For«:="for ", _
                     Next«:="continue", _
                     Break«:="continue", _
                     Opener«:=" {", _
                     Closer«:="} ", _
                     Indenter:=vbTab, _
                     Comment:="'")
Stop
    Debug.Print CodeBlock
End Sub

Public Function fJSCleaner(ByRef CodeBlock As String) As Boolean
'!!! ToDo: only if not inside comment block
    Dim aComment() As String
    Dim aStatement() As String
    Dim lgStatement As Long

    ' Clean code
    CodeBlock = VBA.Replace$(CodeBlock, vbTab, "  ")        ' Avoid odd chars
    CodeBlock = VBA.Replace$(CodeBlock, vbLf, vbCrLf)       ' Avoid impropper breaks
'!!!!
    CodeBlock = VBA.Replace$(CodeBlock, "; ", vbCrLf)       ' Avoid combined lines
'!!!!

    ' Avoid traps
    CodeBlock = VBA.Replace$(CodeBlock, "if(", "if (")
    CodeBlock = VBA.Replace$(CodeBlock, "elseif(", "elseif (")
    CodeBlock = VBA.Replace$(CodeBlock, "for(", "for (")

'!!!!
    ' Break one line If
'!!!!

    CodeBlock = VBA.Join(aStatement(), vbCrLf)
End Function

Public Function fVbCleaner(ByRef CodeBlock As String) As Boolean
'!!! ToDo: only if not inside comment block
    Dim aComment() As String
    Dim aStatement() As String
    Dim lgStatement As Long

    ' Clean code
    CodeBlock = VBA.Replace$(CodeBlock, vbTab, "  ")        ' Avoid odd chars
    CodeBlock = VBA.Replace$(CodeBlock, vbLf, vbCrLf)       ' Avoid impropper breaks
    CodeBlock = VBA.Replace$(CodeBlock, ": ", vbCrLf)       ' Avoid combined lines
    CodeBlock = VBA.Replace$(CodeBlock, " _" & vbCrLf, " ") ' Avoid line continuation

    ' Break one line If
    aStatement() = VBA.Split(CodeBlock, vbCrLf)
    For lgStatement = LBound(aStatement) To UBound(aStatement)
        Do While VBA.InStr(1, VBA.LCase$(aStatement(lgStatement)), " then ", vbTextCompare) > 0
            aStatement(lgStatement) = VBA.Replace$(aStatement(lgStatement), " then ", " Then" & vbCrLf, 1, 1, vbTextCompare) & vbCrLf & "End If"
        Loop
    Next lgStatement

    CodeBlock = VBA.Join(aStatement(), vbCrLf)
End Function

Public Function fIIf(ByVal CodeBlock As String)
'ternary Operator (cond ? truepart : falsepart)

End Function

Public Function fForEach(ByVal CodeBlock As String, _
                     Optional ByVal For» As String = "For ", _
                     Optional ByVal Break» As String = "Break", _
                     Optional ByVal Continue» As String = "Exit For", _
                     Optional ByVal For« As String = "for ", _
                     Optional ByVal Break« As String = "break", _
                     Optional ByVal Continue« As String = "continue", _
                     Optional ByVal Opener« As String = " {", _
                     Optional ByVal Closer« As String = "} ", _
                     Optional ByVal Indenter As String = vbTab, _
                     Optional ByVal Comment As String = "'") As String
'for (x in person) {
'}
End Function

Public Function fFor(ByVal CodeBlock As String, _
                     Optional ByVal For» As String = "For ", _
                     Optional ByVal Next» As String = "Next", _
                     Optional ByVal Break» As String = "Exit For", _
                     Optional ByVal For« As String = "for ", _
                     Optional ByVal Next« As String = "continue", _
                     Optional ByVal Break« As String = "continue", _
                     Optional ByVal Opener« As String = " {", _
                     Optional ByVal Closer« As String = "} ", _
                     Optional ByVal Indenter As String = vbTab, _
                     Optional ByVal Comment As String = "'") As String
    Dim aForStatement() As String
    Dim aStatement() As String
    Dim lgStatement As Long
    Dim lgStatements As Long
    Dim bNewVar As Boolean
    Dim bGotoNext As Boolean
    Dim Counter As String

    aForStatement() = VBA.Split(CodeBlock, ";")
    lgStatements = UBound(aForStatement) - LBound(aForStatement) + 1

    If lgStatements >= LBound(aForStatement) + 0 Then
        If VBA.Trim$(aForStatement(LBound(aForStatement) + 0)) = vbNullString Then
            'Optional
            Counter = aForStatement(LBound(aForStatement) + 1)
        Else
            If VBA.InStr(1, aForStatement(LBound(aForStatement) + 0), "var ") > 0 Then
                bNewVar = True
                Counter = aForStatement(LBound(aForStatement) + 0)
            Else
            End If
        End If

    ElseIf lgStatements >= LBound(aForStatement) + 1 Then
        If VBA.Trim$(aForStatement(LBound(aForStatement) + 1)) = vbNullString Then
            'Optional
        End If

    ElseIf lgStatements >= LBound(aForStatement) + 2 Then
        If VBA.Trim$(aForStatement(LBound(aForStatement) + 2)) = vbNullString Then
            'Optional
        End If
    End If

' for (i = 0; i < cars.length; i++) {
'}
'for(var x=0, x<n; x++){...}

End Function

Public Function fFor_(ByVal CodeBlock As String, _
                      Optional ByVal For» As String = "For ", _
                      Optional ByVal Break» As String = "Break", _
                      Optional ByVal Continue» As String = "Exit For", _
                      Optional ByVal For« As String = "for ", _
                      Optional ByVal Break« As String = "break", _
                      Optional ByVal Continue« As String = "continue", _
                      Optional ByVal Opener« As String = " {", _
                      Optional ByVal Closer« As String = "} ", _
                      Optional ByVal Indenter As String = vbTab, _
                      Optional ByVal Comment As String = "'") As String
End Function

Public Function fIf(ByVal CodeBlock As String, _
                    Optional ByVal Then» As String = " Then", _
                    Optional ByVal If» As String = "If ", _
                    Optional ByVal ElseIf» As String = "ElseIf ", _
                    Optional ByVal Else» As String = "Else", _
                    Optional ByVal EndIf» As String = "End If", _
                    Optional ByVal Then« As String = " {", _
                    Optional ByVal If« As String = "if ", _
                    Optional ByVal ElseIf« As String = "elseif ", _
                    Optional ByVal Else« As String = "else", _
                    Optional ByVal EndIf« As String = "}", _
                    Optional ByVal Opener« As String = " {", _
                    Optional ByVal Closer« As String = "} ", _
                    Optional ByVal Indenter As String = vbTab, _
                    Optional ByVal Comment As String = "'") As String
' Translate IF block

    Dim aStatement() As String
    Dim aStatementLevel() As Long
    Dim aStack() As Long
    Dim lgStatement As Long
    Dim lgStatement_End As Long
    Dim lgLevel As Long:    lgLevel = 0
    Dim strCode As String:  strCode = vbNullString
    Dim CodeOut As String:  CodeOut = vbNullString

    ' Split If sub-blocks
    CodeBlock = VBA.Replace$(CodeBlock, Then» & vbCrLf, vbCrLf)
    CodeBlock = VBA.Replace$(CodeBlock, Then», vbCrLf)
    aStatement() = VBA.Split(CodeBlock, vbCrLf)
    ReDim aStatementLevel(LBound(aStatement) To UBound(aStatement))
    ReDim aStack(LBound(aStatement) To UBound(aStatement))
    For lgStatement = LBound(aStatement) To UBound(aStatement)
        strCode = VBA.Trim$(VBA.LCase$(aStatement(lgStatement)))
        If strCode Like If» & "*" Then
            aStack(lgStatement) = 1
            aStatement(lgStatement) = VBA.Mid$(aStatement(lgStatement), _
                                               VBA.InStr(1, aStatement(lgStatement), If», vbTextCompare) + VBA.Len(If»))

            ' Avoid "=" comparison and apply "==" (Note: will fail for "===" intention!)
            aStatement(lgStatement) = VBA.Replace$(aStatement(lgStatement), "=", "==")

            lgLevel = lgLevel + 1
            aStatementLevel(lgStatement) = lgLevel

        ElseIf strCode Like EndIf» & "*" Then
            aStack(lgStatement) = 0
            aStatement(lgStatement) = "'" 'comment... avoid line
            aStatementLevel(lgStatement) = lgLevel
            lgLevel = lgLevel - 1

        ElseIf strCode Like ElseIf» & " *" Then
            aStack(lgStatement) = 2
            aStatement(lgStatement) = VBA.Mid$(aStatement(lgStatement), _
                                               VBA.InStr(1, aStatement(lgStatement), ElseIf», vbTextCompare) + VBA.Len(ElseIf»))
            aStatementLevel(lgStatement) = lgLevel

        ElseIf strCode Like Else» & "*" Then
            aStack(lgStatement) = 3
            aStatement(lgStatement) = "'" 'comment... avoid line
            aStatementLevel(lgStatement) = lgLevel

        Else ' action code
            aStack(lgStatement) = 4
            aStatementLevel(lgStatement) = -lgLevel
            aStatement(lgStatement) = VBA.Trim$(aStatement(lgStatement))
        End If
    Next lgStatement

    lgStatement = LBound(aStatement)
    lgStatement_End = UBound(aStatement)
    CodeOut = fIf_(aStatement(), _
                   aStatementLevel(), _
                   aStack(), _
                   lgStatement, _
                   lgStatement_End, _
                   Then»:=Then», _
                   If»:=If», _
                   ElseIf»:=ElseIf», _
                   Else»:=Else», _
                   EndIf»:=EndIf», _
                   Then«:=Then«, _
                   If«:=If«, _
                   ElseIf«:=ElseIf«, _
                   Else«:=Else«, _
                   EndIf«:=EndIf«, _
                   Opener«:=Opener«, _
                   Closer«:=Closer«, _
                   Indenter:=Indenter, _
                   Comment:=Comment)

    fIf = CodeOut
End Function

Public Function fIf_(ByRef aStatement() As String, _
                     ByRef aStatementLevel() As Long, _
                     ByRef aStack() As Long, _
                     ByRef lgStatement_Start As Long, _
                     ByVal lgStatement_End As Long, _
                     Optional ByVal Then» As String = " Then", _
                     Optional ByVal If» As String = "If ", _
                     Optional ByVal ElseIf» As String = "ElseIf ", _
                     Optional ByVal Else» As String = "Else", _
                     Optional ByVal EndIf» As String = "End If", _
                     Optional ByVal Then« As String = " {", _
                     Optional ByVal If« As String = "if ", _
                     Optional ByVal ElseIf« As String = "elseif", _
                     Optional ByVal Else« As String = "else", _
                     Optional ByVal EndIf« As String = "}", _
                     Optional ByVal Opener« As String = " {", _
                     Optional ByVal Closer« As String = "} ", _
                     Optional ByVal Indenter As String = vbTab, _
                     Optional ByVal Comment As String = "'") As String
' Translate IF sub-block

    Dim CodeOut As String
    Dim lgStatement As Long
    Dim lgStatement_Block As Long
    Dim lgLevel As Long
    Dim Indent As String
    Dim Indent_ As String

    lgLevel = aStatementLevel(lgStatement_Start)
    Indent = VBA.String(lgLevel - 1, Indenter)
    Indent_ = VBA.String(lgLevel, Indenter)
    CodeOut = vbNullString
    CodeOut = CodeOut & Indent & If« & "(" & aStatement(lgStatement_Start) & ")" & Then« & vbLf

    For lgStatement = (lgStatement_Start + 1) To lgStatement_End
        If aStack(lgStatement) = 1 Then ' if sub-block
            lgStatement_Block = lgStatement
            Do Until (aStack(lgStatement_Block) = 0) And (lgLevel + 1 = aStatementLevel(lgStatement_Block))
                lgStatement_Block = lgStatement_Block + 1
            Loop

            CodeOut = CodeOut & _
                      fIf_(aStatement(), _
                           aStatementLevel(), _
                           aStack(), _
                           lgStatement, _
                           lgStatement_Block, _
                           Then»:=Then», _
                           If»:=If», _
                           ElseIf»:=ElseIf», _
                           Else»:=Else», _
                           EndIf»:=EndIf», _
                           Then«:=Then«, _
                           If«:=If«, _
                           ElseIf«:=ElseIf«, _
                           Else«:=Else«, _
                           EndIf«:=EndIf«, _
                           Opener«:=Opener«, _
                           Closer«:=Closer«, _
                           Indenter:=Indenter)

        ElseIf aStack(lgStatement) = 2 Then 'ElseIf
            CodeOut = CodeOut & Indent & Closer« & " " & ElseIf« & "(" & aStatement(lgStatement) & ") " & Opener« & vbLf
            Do While (aStack(lgStatement) = 0) And (lgLevel = aStatementLevel(lgStatement))
                CodeOut = CodeOut & VBA.String(lgLevel, Indenter) & aStatement(lgStatement) & vbLf
            Loop

        ElseIf aStack(lgStatement) = 3 Then 'Else
            CodeOut = CodeOut & Indent & Closer« & " " & Else« & Opener« & vbLf

        ElseIf aStack(lgStatement) = 0 Then 'EndIf
            CodeOut = CodeOut & Indent & EndIf« & ";" & vbLf

        Else 'ElseIf aStack(lgStatement) = 4 Then 'And aStatementLevel(lgStatement) < 0
            If aStatement(lgStatement)  Comment Then
                CodeOut = CodeOut & Indent_ & vbTab & aStatement(lgStatement) & ";" & vbLf
            End If
        End If
    Next lgStatement

    lgStatement_Start = lgStatement_End
    fIf_ = CodeOut
End Function

Here is a VBA equivalent to JS Push function

Sub sPush()
    Dim aArray() As Variant
    Dim PushVal As Variant
    
    aArray() = Range("$A$1:$B$5").Value2 'fArray2D(Array(1, 2))
    PushVal = Range("$A$6:$B$8").Value2 'fArray2D(Array(3, 4))
    aArray() = fArray2D(Array(1, 2))
    PushVal = fArray2D(Array(3, 4))
    Stop
    fPush aArray(), PushVal
    Stop
End Sub

Public Function fArray2D(ByRef aArray As Variant) As Variant()
    Dim aArrTmp() As Variant
    Dim lgArrayDim1 As Long
    Dim lgArrayDim2 As Long
    Dim lgR As Long
    Dim lgC As Long
    
    On Error GoTo Array2D
    lgArrayDim1 = UBound(aArray, 1) - LBound(aArray, 1) + 1
    lgArrayDim2 = UBound(aArray, 2) - LBound(aArray, 2) + 1

    GoTo ExitProc

Array2D:
    If lgArrayDim2 = 0 Then
        ReDim aArrTmp(LBound(aArray, 1), _
                      LBound(aArray, 1) To UBound(aArray, 1))
        
        For lgC = LBound(aArray, 1) To UBound(aArray, 1)
            aArrTmp(LBound(aArray, 1), lgC) = aArray(lgC)
        Next lgC
        
        fArray2D = aArrTmp()
        Erase aArrTmp()
    End If

ExitProc:
    On Error GoTo 0
End Function

Public Function fPush(ByRef aArray() As Variant, _
                      ByRef PushVal As Variant)
    Dim aArrTmp() As Variant
    Dim lgArrayDim1 As Long
    Dim lgArrayDim2 As Long
    Dim lgPushDim1 As Long
    Dim lgPushDim2 As Long
    Dim lgR As Long
    Dim lgR_Push As Long
    Dim lgC As Long
    
    On Error GoTo ErrControl 'Resume Next
    lgArrayDim1 = UBound(aArray, 1) - LBound(aArray, 1) + 1
    lgArrayDim2 = UBound(aArray, 2) - LBound(aArray, 2) + 1
    lgPushDim1 = UBound(PushVal, 1) - LBound(PushVal, 1) + 1
    lgPushDim2 = UBound(PushVal, 2) - LBound(PushVal, 2) + 1
    
    If lgArrayDim2 = lgPushDim2 Then
        ReDim aArrTmp(LBound(aArray, 1) To UBound(aArray, 1) + 1 + UBound(PushVal, 1) - LBound(PushVal, 1), _
                      LBound(aArray, 2) To UBound(aArray, 2))
        lgR_Push = -1
        For lgR = LBound(aArrTmp, 1) To lgArrayDim1 - (1 - LBound(aArray, 1))
            lgR_Push = lgR_Push + 1
            For lgC = LBound(aArray, 2) To UBound(aArray, 2)
                aArrTmp(lgR, lgC) = aArray(LBound(aArray, 1) + lgR_Push, lgC)
            Next lgC
        Next lgR
        
        lgR_Push = -1
        For lgR = lgArrayDim1 + LBound(aArray, 1) To UBound(aArrTmp, 1)
            lgR_Push = lgR_Push + 1
            For lgC = LBound(PushVal, 2) To UBound(PushVal, 2)
                aArrTmp(lgR, lgC) = PushVal(LBound(PushVal, 1) + lgR_Push, lgC)
            Next lgC
        Next lgR
        aArray() = aArrTmp()
        Erase aArrTmp()
    End If

ExitProc:
    On Error GoTo 0
    Exit Function
ErrControl:
    GoTo ExitProc
End Function
[/sourcecode]