How do I parse VBA code line instructions-CodePudding

I am trying to create a VBA function that parses VBA code. I'm at the stage where I'm trying to put in an array variable all the instructions present on a line of code. For example the following code contains two instructions:

strVar = "Some text"
lngVar = 2

Those 2 instructions can also be written as following:

strVar = "Some text": lngVar = 2

I specify that I already have a personal function that transforms a "multiline" line into a simple line:

strVar = "From text": _
  lngVar = 2 'Multiline'

So the CodeLine argument (the line of code to be parsed) of my custom function always contains a single code line. I thought I had reached the desired result since I get the right result with some twisted lines such as :

str = " : 1": str = " : 2": str = " : 2"

str = """ : 1""": str = """ : 2""": str = """ :"" 2""

But I realize that I don't get the desired result for this kind of lines:

Next vntSubString: CommentPosition = IIf(blnStringMode, 0, InStr(1, CodeLine, ": "))

I'd really like to do something generic and quick to execute, I think I'm not too far from the final result, but I'm a bit blocked.

Here's what my personal function looks like at the moment:

Public Function SplitInstructions(ByVal CodeLine As String) As Variant()

  Dim vntResult() As Variant
  Dim vntSubString¹ As Variant
  Dim blnIsStringMode As Boolean 'Determines if we are in a subtext between quotes or not
  Dim vntSubString² As Variant

  Let vntResult = VBA.Array

  If InStr(1, CodeLine, ": ") = 0 Then 'A single instruction
    Let vntResult = VBA.Array(CodeLine)
  ElseIf InStr(1, CodeLine, """") = 0 Then 'Several statements, but no quotes => On Split
    Do Until VBA.InStr(1, CodeLine, "::") = 0
      Let CodeLine = VBA.Replace(CodeLine, "::", ":")
    Loop: Call AddToArray(vntResult, Split(CodeLine, ":"))
  Else 'it gets complicated
    For Each vntSubString¹ In Split(CodeLine, """")
      If blnIsStringMode Then
        Let vntResult(UBound(vntResult)) = Trim$(vntResult(UBound(vntResult)) & """" & vntSubString¹ & """")
      Else
        For Each vntSubString² In Split(vntSubString¹, ": ")
          If vntSubString² <> vbNullString Then Call AddToArray(vntResult, vntSubString²)
        Next vntSubString²
      End If
      Let blnIsStringMode = Not blnIsStringMode
    Next vntSubString¹
  End If

  Let SplitInstructions = vntResult

End Function

Private Sub AddToArray(ByRef Arr() As Variant, ByVal Value As Variant)

  Dim vntValue As Variant

  If VBA.IsArray(Value) Then
    For Each vntValue In Value
      Call AddToArray(Arr, vntValue)
    Next vntValue
  Else
    ReDim Preserve Arr(LBound(Arr) To UBound(Arr)   1)
    Let Arr(UBound(Arr)) = Value
  End If

End Sub

In advance, thank you for your help!

Edit : here is the function I use to determine then comment position of a code line

Private Function CommentPosition(ByVal CodeLine As String) As Long

  Dim vntSubString As Variant
  Dim blnStringMode As Boolean
  Dim x As Long

  For Each vntSubString In VBA.Split(CodeLine, """")
    If Not blnStringMode Then
      Let x = VBA.InStr(1, vntSubString, "'")
      If x > 0 Then
        Let CommentPosition = CommentPosition   x
        Exit Function
      End If
    End If
    Let blnStringMode = Not blnStringMode
    Let CommentPosition = CommentPosition   VBA.Len(vntSubString)   1
  Next vntSubString

  Let CommentPosition = VBA.IIf(blnStringMode, 0, VBA.InStr(1, CodeLine, "'"))

End Function

CodePudding user response：

If you want to split on double quotes, you'd need to determine if you're inside a set of parentheses and keep all of that together. I think that's a lot of work. What if you just iterate through the string sequentially?

Public Function SplitInstructions2(ByVal CodeLine As String) As String()
    
    Dim i As Long
    Dim lLastPos As Long
    Dim aReturn() As String
    Dim bInString As Boolean
    Dim lCnt As Long
    
    ReDim aReturn(1 To 1000)
    lLastPos = 1
    
    For i = 1 To Len(CodeLine)
        If Mid$(CodeLine, i, 1) = ":" And Not bInString Then
            lCnt = lCnt   1
            aReturn(lCnt) = Trim$(Mid$(CodeLine, lLastPos, i - lLastPos))
            lLastPos = i   1
        ElseIf Mid$(CodeLine, i, 1) = """" Then
            bInString = Not bInString
        End If
    Next i
    
    lCnt = lCnt   1
    aReturn(lCnt) = Trim$(Mid$(CodeLine, lLastPos, Len(CodeLine) - lLastPos   1))
    
    ReDim Preserve aReturn(1 To lCnt)
    
    SplitInstructions2 = aReturn
    
End Function

CodePudding user response：

Building on Dick's answer to parse the string, but utilising InStr to look ahead to the next character of interest:

Sub test()
    Dim CodeLine As String
    Dim CodeLines() As String
    
    CodeLine = "str = """""" : 1"""""": str = """""" : 2"""""": str = """""" :"""" 2"""""

    CodeLines = SplitInstructions(CodeLine)
    
    Stop
End Sub

Function SplitInstructions(ByVal CodeLine As String) As String()
    Dim CharOfInterest As String
    Dim idx As Long
    Dim aReturn() As String
    Dim NumLines As Long
    
    ReDim aReturn(1 To 1000)
    NumLines = 1
    aReturn(1) = CodeLine
    idx = 1
    Do
        Debug.Print aReturn(NumLines), idx
        CharOfInterest = GetNextCharOfInterest(aReturn(NumLines), idx)
        Select Case CharOfInterest
            Case """"
                ' Ignore remainder of quoted string
                idx = GetStringClose(aReturn(NumLines), idx)   1
            Case ":"
                ' Break on :
                aReturn(NumLines   1) = Trim$(Mid$(aReturn(NumLines), idx   1))
                aReturn(NumLines) = Trim$(Left$(aReturn(NumLines), idx - 1))
                NumLines = NumLines   1
                idx = 1
            Case "'", vbNullString
                ' Comment, or end of code
                ReDim Preserve aReturn(1 To NumLines)
                Exit Do
        End Select
    Loop
    SplitInstructions = aReturn
End Function

' Look ahead to end of Quoted string
Function GetStringClose(CodeLine As String, ByRef idx As Long)
    Dim i As Long
    If Mid$(CodeLine, idx, 1) = """" Then 'verfiy
        i = InStr(idx   1, CodeLine, """")
        Do
            If Mid$(CodeLine, i   1, 1) = """" Then
                ' delimited "
                i = i   1
                i = InStr(i   1, CodeLine, """")
            Else
                ' end of quoted string
                i = IIf(i = 0, Len(CodeLine)   1, i)
                GetStringClose = i
                Exit Do
            End If
        Loop
    Else
        'invalid call
        Stop
    End If
End Function


Function GetNextCharOfInterest(CodeLine As String, idx As Long) As String
    Dim Quote As Long
    Dim Colon As Long
    Dim Comment As Long
    Dim MinPos As Long
    
    If idx > Len(CodeLine) Then
        GetNextCharOfInterest = vbNullString
        Exit Function
    End If
    Quote = InStr(idx, CodeLine, """")
    Colon = InStr(idx, CodeLine, ":")
    Comment = InStr(idx, CodeLine, "'")
    
    If Quote   Colon   Comment = 0 Then
        GetNextCharOfInterest = vbNullString
    Else
        Quote = IIf(Quote = 0, Len(CodeLine)   1, Quote)
        Colon = IIf(Colon = 0, Len(CodeLine)   1, Colon)
        Comment = IIf(Comment = 0, Len(CodeLine)   1, Comment)
        
        MinPos = Application.Min(Quote, Colon, Comment)
        If Quote = MinPos Then
            GetNextCharOfInterest = """"
            idx = Quote
        ElseIf Colon = MinPos Then
            GetNextCharOfInterest = ":"
            idx = Colon
        Else
            GetNextCharOfInterest = "'"
            idx = Comment
        End If
    End If
End Function

The test result