Conclusion regarding CodeModule.Find via search pattern
Firstly, CodeModule.Find doesn't help via search pattern and its possible use is intransparent.
I agree that the VBIDE API is extremely limited and that there exist excellent professional tools which I highly recommand for any programmer :-)
Consequence: Work around via XML
Secondly I prefer household remedies if possible, so I tried to find an alternative solution using only the helpful parts of VBIDE.
Method
That is why I tried a simple xml conversation of the CodeModule.Lines allowing a flexible search within logical lines.
Instead of using regular expressions in requesting the xml data, I demonstrate a method to find leading numbers via a well defined XPath search (loop thru node list),
thus resolving most problems shown by @ThunderFrame. The search string in function showErls is defined as "line[substring(translate(.,'0123456789','¹¹¹¹¹¹¹¹¹¹'),1,1)="¹"]"
Furthermore function 'lineNumber' returns the logical line number within the module.
Note: To keep it simple, the search is restrained to one module only (user defined constant MYMODULE) and code avoids any regex.
Work around code - main sub
Option Explicit
' ==========================================
' User defined name of module to be analyzed
' ==========================================
Const MYMODULE = "modThunderFrame" ' << change to existing module name or userform
' Declare xml file as object
Dim xCMods As Object ' Late Binding; instead of Early Bd: Dim xCMods As MSXML2.DOMDocument6
Public Sub TestLineNumbers()
' =================
' A. Load/refresh code into xml
' =================
' set xml into memory - contains code module(s) lines
Set xCMods = CreateObject("MSXML2.Domdocument.6.0") ' L.Bd.; instead of E.Bd: Set xCMods = New MSXML2.DOMDocument60
xCMods.async = False
xCMods.validateOnParse = False
' read in user defined code module and load xml, if failed show error message
refreshCM MYMODULE
If xCMods Is Nothing Then Exit Sub
' ======================
' B. search line numbers
' ======================
showERLs
' =============================
' C. Save xml if needed
' =============================
' xCMods.Save ThisWorkbook.Path & "\VBE(" & MYMODULE & ").xml"
' MsgBox "Successfully exported Excel data to " & ThisWorkbook.Path & "\VBE(" & MYMODULE & ").XML!", _
' vbInformation, "Module " & MYMODULE & " to xml"
' =================
' D. terminate xml
' =================
Set xCMods = Nothing
End Sub
Sub procedures
Private Sub showERLs()
' Purpose: [B.] declare XPath search string and define special translate character
Dim s As String
Dim S1 As String: S1 = Chr(185) ' superior number 1 (hex B9) replaces any digit
' declare node and node list
Dim line As Object
Dim lines As Object
' define XPath search string for first digit in line (usual case)
s = "line[substring(translate(.,'0123456789','" & String(10, S1) & "'),1,1)=""" & _
S1 & _
"""]"
' start debugging
Debug.Print "**search string=""" & s & """" & vbNewLine & String(50, "-")
Debug.Print "Line #|Line Content" & vbNewLine & String(50, "-"); ""
' set node list
Set lines = xCMods.DocumentElement.SelectNodes(s)
' -------------------
' loop thru node list
' -------------------
For Each line In lines
Debug.Print Format(lineNumber(line), "00000") & "|" & line.Text ' return logical line number plus line content
Next line
End Sub
Private Sub refreshCM(sModName As String)
' Purpose: [A.] load xml string via LoadXML method
Dim sErrTxt As String
Dim line As Object
Dim lines As Object
Dim xpe As Object
Dim s As String ' xpath expression
Dim pos As Integer ' position of line number prefix
' ======================================
' 1. Read code module lines and load xml
' ======================================
If Not xCMods.LoadXML(readCM(sModName)) Then
' set ParseError object
Set xpe = xCMods.parseError
With xpe
sErrTxt = sErrTxt & vbNewLine & String(20, "-") & vbNewLine & _
"Loading Error No " & .ErrorCode & " of xml file " & vbCrLf & _
Replace(" " & Replace(.URL, "file:///", "") & " ", " ", "[No file found]") & vbCrLf & vbCrLf & _
xpe.reason & vbCrLf & _
"Source Text: " & .srcText & vbCrLf & _
"char?: " & """" & Mid(.srcText, .linepos, 1) & """" & vbCrLf & vbCrLf & _
"Line no: " & .line & vbCrLf & _
"Line pos: " & .linepos & vbCrLf & _
"File pos.: " & .filepos & vbCrLf & vbCrLf
End With
MsgBox sErrTxt, vbExclamation, "XML Loading Error"
Set xCMods = Nothing
Exit Sub
End If
' 2. resolve hex input problem of negative line numbers with leading space (thx @Thunderframe)
s = "line"
Set lines = xCMods.DocumentElement.SelectNodes(s)
' loop thru all logical lines
For Each line In lines
pos = ErlPosInLine(line.Text)
If pos <= Len(line.Text) Then
' to do: add attribute to line node, if wanted
' correct line content
line.Text = Mid(line.Text, pos)
End If
Next
End Sub
Private Function lineNumber(node As Object) As Long
' Purpose: [B.] return logical line number within code module lines
' Param.: IXMLDomNode
' Method: XPath via preceding-sibling count plus one
Dim tag As String: tag = "line"
lineNumber = node.SelectNodes("preceding-sibling::" & tag).Length + 1
End Function
Private Function readCM(Optional modName = "*") As String
' Purpose: return code module line string (VBIDE) of a user defined module to be read into xml
' Call: called from [A.] refreshCM
' xCMods.LoadXML(readCM(sModName))
' Declare variable
Dim s As String
Dim md As CodeModule
If modName = "*" Then Exit Function
On Error GoTo OOPS
' get code module lines into string
Set md = Application.VBE.ActiveVBProject.VBComponents(modName).CodeModule ' MSAccess: Modules("modVBELines")
' change to xml tags
s = getTags(md.lines(1, md.CountOfLines))
' return
readCM = s
OOPS:
End Function
Private Function getTags(ByVal s As String, Optional mode = False) As String
' Purpose: prepares xml string to be loaded
' define constant
Const HEAD = "<?xml version=""1.0"" encoding=""utf-8""?>" & vbCrLf & "<cm>" & vbCrLf
' 1. change tag characters
s = Replace(Replace(s, "<", "<"), ">", ">")
' 2. change special characters (ampersand)
s = Replace(s, "&", "&")
' 3. change "_" points
s = Replace(s, "_" & vbCrLf, Chr(133) & vbLf)
' 4. define logical line entities
If Right(s, 2) = vbCrLf Then s = Left(s, Len(s) - 2)
s = HEAD & " <line>" & Replace(s, vbCrLf, "</line>" & vbCrLf & " <line>") & "</line>" & vbCrLf & "</cm>"
' debug xml tags if second function parameter is true (mode = True)
If mode Then Debug.Print s
' return
getTags = s
End Function
Sub testErlPosInLine()
' Purpose: Test Thunderframe's problem with ERL prefixes (underscores, " ",..) and hex inputs
Dim s As String
s = " _" & vbLf & " -1 xx"
MsgBox "|" & Mid(s, ErlPosInLine(s)) & "|" & vbNewLine & _
"prefix = |" & Mid(s, 1, ErlPosInLine(s) - 1) & "|"
End Sub
Private Function ErlPosInLine(ByVal s As String) As Integer
' Purpose: remove prefix (underscore, tab, " ",.. ) from numbered line
' cf: http://stackoverflow.com/questions/42716936/vba-to-remove-numbers-from-start-of-string-cell
Dim i As Long
For i = 1 To Len(s) ' loop each char
Select Case Mid$(s, i, 1) ' examine current char
Case " " ' permitted chars
Case "_"
Case vbLf, Chr(133), Chr(34)
Case "0" To "9": Exit For ' cut off point
Case Else: Exit For ' i is the cut off point
End Select
Next
If Mid$(s, i, 1) = "-" And Len(s) > 1 Then
If IsNumeric(Mid$(s, i + 1, 1)) Then i = i + 1
End If
' return
ErlPosInLine = i
' debug.print Mid$(s, i) '//strip lead
End Function