By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,480 Members | 2,192 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,480 IT Pros & Developers. It's quick & easy.

Ignore Comments in code

PhilOfWalton
Expert 100+
P: 1,430
I am trying to parse code to extract various words using

Expand|Select|Wrap|Line Numbers
  1. Module.CodeModule.Lines(LineNo, 1)
  2.  
this for example gives me something like

Expand|Select|Wrap|Line Numbers
  1. ElseIf InStr(OriginalMsg, "PLP_MessageBox(" & StrSearchTerm) > 0 Then       ' Look for PLP_MessageBox(PLP_Msg)
  2.  
I am trying to find a method of ignoring everything after the "'" comment identifier:- Chr$(39)

So the obvious thing is to search backwards for a "'" Chr$(39) and ignore everything after that.
That fails for a comment like
Expand|Select|Wrap|Line Numbers
  1. ' Can't find the table
  2.  
If there is no comment, working backwards will fail on
Expand|Select|Wrap|Line Numbers
  1. DLookup('MyWord', 'MyTable')
  2.  
The only guaranteed success I have had is if a comment is on a line of it's own.
Expand|Select|Wrap|Line Numbers
  1. If Left(Trim(.CodeModule.Lines(LineNo, 1)),1) = Chr$(39) then ...
  2. End If
  3.  
Now the VBA Editor recognises comments, as on my editor the font turns green

Has anyone any ideas how this can be achieved?

Thanks

Phil
Oct 21 '17 #1

✓ answered by Rabbit

So the solution is a similar methodology, just modified to account for possible single quotes and double quotes within the comment itself.

Basically, I use a recursive function to strip out paired double quotes starting from the beginning of the string until the first occurrence of a single quote outside of double quotes.

The Function
Expand|Select|Wrap|Line Numbers
  1. Function CommentFinder(strInput As String) As String
  2.     Dim strLength As Integer, firstSingleLoc As Integer, firstDoubleLoc As Integer
  3.  
  4.     strLength = Len(strInput)
  5.     firstSingleLoc = InStr(1, strInput, "'")
  6.     firstDoubleLoc = InStr(1, strInput, """")
  7.  
  8.     If firstSingleLoc = 0 Then ' No comment found
  9.         CommentFinder = ""
  10.     ElseIf firstSingleLoc < firstDoubleLoc Or firstDoubleLoc = 0 Then ' Comment found, first double quote after comment or no double quote
  11.         CommentFinder = Mid(strInput, firstSingleLoc, strLength)
  12.     Else ' Possible comment found, double quote found, find paired double quote and recurse
  13.         Dim pairedDoubleLoc As Integer
  14.         pairedDoubleLoc = InStr(firstDoubleLoc + 1, strInput, """")
  15.         CommentFinder = CommentFinder(Mid(strInput, pairedDoubleLoc + 1, strLength))
  16.     End If
  17. End Function
The Test
Expand|Select|Wrap|Line Numbers
  1. Sub CommentFinderTest()
  2.     Dim testStr As String
  3.  
  4.     testStr = "test string with 'comment at end"
  5.     Debug.Print ""
  6.     Debug.Print testStr
  7.     Debug.Print CommentFinder(testStr)
  8.  
  9.     testStr = "test ""string"" with 'double quotes before comment at end"
  10.     Debug.Print ""
  11.     Debug.Print testStr
  12.     Debug.Print CommentFinder(testStr)
  13.  
  14.     testStr = "test ""st'ring"" with 'double quotes and single quote before comment at end"
  15.     Debug.Print ""
  16.     Debug.Print testStr
  17.     Debug.Print CommentFinder(testStr)
  18.  
  19.     testStr = "test ""st'ring"" with double quotes and single quote and no comment"
  20.     Debug.Print ""
  21.     Debug.Print testStr
  22.     Debug.Print CommentFinder(testStr)
  23.  
  24.     testStr = "test ""st'ring"" with 'double quotes"" and"" single' quote' before and after comment"
  25.     Debug.Print ""
  26.     Debug.Print testStr
  27.     Debug.Print CommentFinder(testStr)
  28.  
  29.     testStr = "test """"""st'''r""""ing"" with 'escaped double quote sequences"
  30.     Debug.Print ""
  31.     Debug.Print testStr
  32.     Debug.Print CommentFinder(testStr)
  33. End Sub

Share this Question
Share on Google+
10 Replies


ADezii
Expert 5K+
P: 8,597
If your Comments are consistently defined as
Expand|Select|Wrap|Line Numbers
  1. ' <space>Comment
namely
Expand|Select|Wrap|Line Numbers
  1. ' Can't find the Table
  2. Chr(39) & Chr(32) & "Comment"
then it should be a simple matter to eliminate Lines that start with
Expand|Select|Wrap|Line Numbers
  1. ' <space>
Oct 21 '17 #2

PhilOfWalton
Expert 100+
P: 1,430
To explain further, I an writing a Db to translate other people's Dbs into foreign languages. It is going surprisingly well, but I have no control over their code. 99% of their DB will remain unchanged. The major exception is, if they want their Msgboxes translating into a foreign language, but this simply means changing
"MsgBox" to "PLP_MessageBox", which is a simple find & replace job.

So going back to your suggestion, I have no control over their code so can't look for the Chr$(39) space that you are suggesting.

This would fail anyway with
' Comment1 ' Comment2 (bit similar to my "Can't" example in the original post

Don't think it's going to be easy, but as I said, the VBA editor gets it right

Thanks

Phil
Oct 21 '17 #3

Rabbit
Expert Mod 10K+
P: 12,315
Read a line, split on single quote.

If number of elements in the returned array is even, then that means there's an unpaired single quote. The last element will be the comment.

You might have to do something similar to handle double quotes as well.

You don't need to look backwards, you need to look forward and find the start of possible strings until the string closes or you get to the end of the line.
Oct 22 '17 #4

PhilOfWalton
Expert 100+
P: 1,430
Thanks for trying, but that doesn't work if my comment is

Expand|Select|Wrap|Line Numbers
  1.     ' That idea does't work
  2.  
In other words if there is a odd number of quotes within the comment, any pairing method will fail.

Phil
Oct 22 '17 #5

Rabbit
Expert Mod 10K+
P: 12,315
That works too, because it's an unpaired single quote. You're not looking for pairs, you're excluding pairs.

Start by excluding all double quote pairs. Then exclude single quote pairs. What's left are any unpaired single quotes. In the example above, there are no pairs to exclude, all that's left is the unpaired comment.

Edit: oh, I see what you mean, I didn't see the other quote the first time.
Oct 22 '17 #6

Rabbit
Expert Mod 10K+
P: 12,315
So the solution is a similar methodology, just modified to account for possible single quotes and double quotes within the comment itself.

Basically, I use a recursive function to strip out paired double quotes starting from the beginning of the string until the first occurrence of a single quote outside of double quotes.

The Function
Expand|Select|Wrap|Line Numbers
  1. Function CommentFinder(strInput As String) As String
  2.     Dim strLength As Integer, firstSingleLoc As Integer, firstDoubleLoc As Integer
  3.  
  4.     strLength = Len(strInput)
  5.     firstSingleLoc = InStr(1, strInput, "'")
  6.     firstDoubleLoc = InStr(1, strInput, """")
  7.  
  8.     If firstSingleLoc = 0 Then ' No comment found
  9.         CommentFinder = ""
  10.     ElseIf firstSingleLoc < firstDoubleLoc Or firstDoubleLoc = 0 Then ' Comment found, first double quote after comment or no double quote
  11.         CommentFinder = Mid(strInput, firstSingleLoc, strLength)
  12.     Else ' Possible comment found, double quote found, find paired double quote and recurse
  13.         Dim pairedDoubleLoc As Integer
  14.         pairedDoubleLoc = InStr(firstDoubleLoc + 1, strInput, """")
  15.         CommentFinder = CommentFinder(Mid(strInput, pairedDoubleLoc + 1, strLength))
  16.     End If
  17. End Function
The Test
Expand|Select|Wrap|Line Numbers
  1. Sub CommentFinderTest()
  2.     Dim testStr As String
  3.  
  4.     testStr = "test string with 'comment at end"
  5.     Debug.Print ""
  6.     Debug.Print testStr
  7.     Debug.Print CommentFinder(testStr)
  8.  
  9.     testStr = "test ""string"" with 'double quotes before comment at end"
  10.     Debug.Print ""
  11.     Debug.Print testStr
  12.     Debug.Print CommentFinder(testStr)
  13.  
  14.     testStr = "test ""st'ring"" with 'double quotes and single quote before comment at end"
  15.     Debug.Print ""
  16.     Debug.Print testStr
  17.     Debug.Print CommentFinder(testStr)
  18.  
  19.     testStr = "test ""st'ring"" with double quotes and single quote and no comment"
  20.     Debug.Print ""
  21.     Debug.Print testStr
  22.     Debug.Print CommentFinder(testStr)
  23.  
  24.     testStr = "test ""st'ring"" with 'double quotes"" and"" single' quote' before and after comment"
  25.     Debug.Print ""
  26.     Debug.Print testStr
  27.     Debug.Print CommentFinder(testStr)
  28.  
  29.     testStr = "test """"""st'''r""""ing"" with 'escaped double quote sequences"
  30.     Debug.Print ""
  31.     Debug.Print testStr
  32.     Debug.Print CommentFinder(testStr)
  33. End Sub
Oct 22 '17 #7

PhilOfWalton
Expert 100+
P: 1,430
Thanks for the new code.

I am trying to test it out on
Expand|Select|Wrap|Line Numbers
  1. MsgBox "Can't find it"        ' No My Field
  2.  
But having little success. That is an actual line from some code, so I want to strip out the comment so that I can examine the code.

If your method works, I just replace the comment with "", then trim what remains

Thanks

Phil
Oct 23 '17 #8

Rabbit
Expert Mod 10K+
P: 12,315
Just tested it, and yes, it works on that line of code
Oct 23 '17 #9

PhilOfWalton
Expert 100+
P: 1,430
Firstly a big Thank you - seems to be spot on

As a matter if interest I have used the following to create a text file with all the code and the comments highlighted.
It might be of use to semeone

Expand|Select|Wrap|Line Numbers
  1. Function GetVBEDeatils()
  2.     On Error GoTo Error_Handler
  3.     Dim vbProj                As VBIDE.VBProject
  4.     Dim vbComp                As VBIDE.VBComponent
  5.     Dim vbMod                 As VBIDE.CodeModule
  6.     Dim pk                    As VBIDE.vbext_ProcKind
  7.     Dim sProcName             As String
  8.     Dim strFile               As String
  9.     Dim iCounter              As Long
  10.     Dim FileNumber            As Integer
  11.     Dim bFileClosed           As Boolean
  12.     Const vbNormalFocus = 1
  13.     Dim StrLine As String
  14.     Dim StrComment As String
  15.     Dim j As Long
  16.  
  17.     'Where do you want the text file created
  18.     strFile = "E:\Phil Data\Access\Mdb 2010\Mike\Mike\ModulesTest.txt"
  19.     If Len(Dir(strFile)) > 0 Then Kill strFile
  20.     FileNumber = FreeFile                           'Get unused file number.
  21.     Open strFile For Append As #FileNumber          'Create file name.
  22.       ' Print the Db header
  23.     Print #FileNumber, "Database: " & Application.CurrentProject.Name
  24.     Print #FileNumber, "Database Path: " & Application.CurrentProject.Path
  25.     Print #FileNumber, String(80, "*")
  26.     Print #FileNumber, String(80, "*")
  27.     Print #FileNumber, ""
  28.  
  29.     For Each vbProj In Application.VBE.VBProjects   'Loop through each project
  30.         Print #FileNumber, "VBA Project Name: " & vbProj.Name
  31.  
  32.         For Each vbComp In vbProj.VBComponents      'Loop through each module
  33.             Set vbMod = vbComp.CodeModule
  34.           ' Modole Name
  35.             Print #FileNumber, "   " & vbComp.Name & " :: " & _
  36.                                vbMod.CountOfLines & " total lines"
  37.             Print #FileNumber, "   " & String(80, "*")
  38.             iCounter = 1
  39.             Do While iCounter < vbMod.CountOfLines  'Loop through each procedure
  40.                 sProcName = vbMod.ProcOfLine(iCounter, pk)
  41.                 If sProcName <> "" Then
  42.                     Print #FileNumber, ""
  43.                     Print #FileNumber, "      " & sProcName & " :: " & _
  44.                                        vbMod.ProcCountLines(sProcName, pk) & " lines"
  45.                   For j = 1 To vbMod.CountOfLines
  46.                       StrLine = vbComp.CodeModule.Lines(j, 1)
  47.                       If Trim(StrLine) > "" Then                         ' Blank line
  48.                           Print #FileNumber, "          Line: " & StrLine
  49.                           StrComment = CommentFinder(StrLine)
  50.                           If StrComment > "" Then
  51.                               Print #FileNumber, "          ** COMMENT: " & StrComment
  52.                           End If
  53.                       End If
  54.                   Next j
  55.  
  56.                     iCounter = iCounter + vbMod.ProcCountLines(sProcName, pk)
  57.                 Else
  58.                     iCounter = iCounter + 1
  59.                 End If
  60.             Loop
  61.             Print #FileNumber, ""
  62.         Next vbComp
  63.     Next vbProj
  64.  
  65.     Close #FileNumber                               'Close file.
  66.     bFileClosed = True
  67.  
  68.     'Open the generated text file
  69.     Shell "cmd /c """ & strFile & """", vbNormalFocus
  70.     'In Access you could also use the following line instead of the previous one.
  71.     'Application.FollowHyperlink strFile
  72.  
  73. Error_Handler_Exit:
  74.     On Error Resume Next
  75.     If bFileClosed = False Then Close #FileNumber   'Close file.
  76.     If Not vbMod Is Nothing Then Set vbMod = Nothing
  77.     If Not vbComp Is Nothing Then Set vbComp = Nothing
  78.     If Not vbProj Is Nothing Then Set vbProj = Nothing
  79.     Exit Function
  80.  
  81. Error_Handler:
  82.     MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
  83.            "Error Number: " & Err.Number & vbCrLf & _
  84.            "Error Source: GetVBEDeatils" & vbCrLf & _
  85.            "Error Description: " & Err.Description & _
  86.            Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
  87.            , vbOKOnly + vbCritical, "An Error has Occured!"
  88.     Resume Error_Handler_Exit
  89. End Function
  90.  
Phil
Oct 24 '17 #10

Rabbit
Expert Mod 10K+
P: 12,315
Glad to be of help
Oct 24 '17 #11

Post your reply

Sign in to post your reply or Sign up for a free account.