Extract Text Between Two Flags With an Offset

Category:

String Manipulation

Type:

Snippets

Difficulty:

Intermediate

Author: Anonymous

Version Compatibility: Visual Basic 6

More information:

Useful for getting text extracted from a long string (eg, HTML retrieved back) when having to use one-off opening flags. Ie, you need to get a piece of text from a string but you need to find where to start after finding one target flag first. See snippet comment block for more information. I wrote this specifically to help with extracting desired text from large, complicated HTML source.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

' sngReturnedOccurrenceLocation holds the location in sSource of the returned occurrence of the extracted text.  This
'   is the location of the first char of the text between the start and end flag text, not of the sflagstart (or
'   sflagstart2) value associated with it.  So if the value of sflagstart (or sflagstart2) is "123" and that of sflagend
'   is "World" and the value of sSource is "123HelloWorld", then the returned text will of course be 'Hello' and the
'   value of sngReturnedOccurrenceLocation will be set to 4, since the extracted text, 'Hello', starts at character number
'   4 in the sSource string value.  Note sngReturnedOccurrenceLocation is passed into the function ByRef so that the value
'   it is set to will be accessible in the calling function.  [Important: Since in order to get this value back the call
'   has to be ByRef, the Single variable declared and passed into the function MUST be a Single-- not a Variant.  If you
'   declare the variable on a multiple-variable Dim line and do not specify the data type for it, then unless it is listed
'   last, it will be a Variant and not a Single.  Eg:

'
'   Dim sngOne, sngTwo, sngReturnedLocn as Single
'
'   will create sngReturnedLocn as a Single but sngOne and sngTwo will be Variants.  But if you do as follows:
'
'   Dim sngOne as Single, sngTwo as Single, sngReturnedLocn as Single
'
'   then all three variables will be Single.]
'   --> Also note that if the function's returned value is an empty string, the value of this variable will be equal to
'    the location of the first character of the string value of sflagend.  This occurs when the specified start flag (or
'    the second start flag if that is relevant) and end flag values have no intervening characters of any kind.  <--
'
' sngOccurrenceStart defaults to 1.  If user supplies < 1, extractData returns "".  If user supplies > 1, then
'   extractData looks for the occurrence of the desired text at that occurrence number within the sSource string.
'   If none is found at that occurrence number, extractData returns "" and the value of sngReturnedOccurrenceLocation
'   will be returned as 0.
'
' sngCharacterCountStart defaults to 1.  Otherwise if the user supplies a value other than 1, the logic starts looking
'   for the flag values from that point in sSource.  If the supplied value is < 1 or the value is greater than the
'   Len(sSource), extractData returns "".  If a value is supplied for both this parameter and sngOccurrenceStart,
'   the logic starts looking for the flag values after the point in sSource indicated by sngCharacterCountStart, ie,
'   counting the first occurrence of the found flag values as occurrence #1 only *after* that point in sSource indicated
'   by the value of sngCharacterCountStart.
'
' If bCaseSensitive is set to True by the user, case-sensitive comparisons for the purpose of locating the
'   sflagstart, sflagstart2, and sflagend values are used.
' If bReportParameterErrors is set by the user to True, message boxes will be displayed indicating if any of
'   the following parameters were passed in as "": sSource, sflagstart, sflagend.  If sngOccurrenceStart is passed in
'   with a value < 1, it also reports that.
'
Public Function extractText(sSource$, sflagstart$, sflagstart2$, sflagend$, _
       ByRef sngReturnedOccurrenceLocation As Single, _
       Optional ByVal sngCharacterCountStart As Single = 1, _
       Optional ByVal sngOccurrenceStart As Single = 1, _
       Optional bCaseSensitive As Boolean = False, _
       Optional bReportParameterErrors As Boolean = False) As String

Dim sngPosition, sngStart, sngEnd, sngSourceLen As Single
Dim lngCount As Long
Dim sTheText$, sOffsetText$
Dim iCompMode%

On Error GoTo errh

sngReturnedOccurrenceLocation = CSng(0)

' Check parameters
If sSource = "" Then
 If bReportParameterErrors Then
   MsgBox "extractText(): Source text string is empty.", vbInformation, _
          "Cannot use supplied parameter"
 End If
 extractText = ""
 Exit Function
End If ' If sSource = "" Then

If sflagstart = "" Then
 If bReportParameterErrors Then
   MsgBox "extractText(): Cannot use a 0-length start flag.", vbInformation, _
          "Cannot use supplied parameter"
 End If
 extractText = ""
 Exit Function
End If ' If sflagstart = "" Then

If sflagend = "" Then
 If bReportParameterErrors Then
   MsgBox "extractText(): Cannot use a 0-length end flag.", vbInformation, _
          "Cannot use supplied parameter"
 End If
 extractText = ""
 Exit Function
End If ' If sflagend = "" Then

If sngCharacterCountStart < 1 Then
 If bReportParameterErrors Then
   MsgBox "extractText(): Cannot use a character count start value less than 1.", _
          vbInformation, _
          "Cannot use supplied parameter"
 End If
 extractText = ""
 Exit Function
End If ' If sngOccurrenceStart < 1 Then

If sngOccurrenceStart < 1 Then
 If bReportParameterErrors Then
   MsgBox "extractText(): Cannot use an occurrence starting point value less than 1.", vbInformation, _
          "Cannot use supplied parameter"
 End If
 extractText = ""
 Exit Function
End If ' If sngOccurrenceStart < 1 Then

sngSourceLen = Len(sSource)

If sngCharacterCountStart > sngSourceLen Then
 If bReportParameterErrors Then
   MsgBox "extractText(): Cannot use an character count starting point greater than the length of the source string.", _
          vbInformation, _
          "Cannot use supplied parameter"
 End If
 extractText = ""
 Exit Function
End If ' If sngCharacterCountStart > sngSourceLen Then

'''''''''''''''''

'
' Now for some actual work ...
'

sngPosition = sngCharacterCountStart

If bCaseSensitive Then
 iCompMode = VbCompareMethod.vbBinaryCompare
Else
 iCompMode = VbCompareMethod.vbTextCompare
End If

For lngCount = 1 To sngOccurrenceStart
 sOffsetText = sflagstart
 sngStart = InStr(sngPosition, sSource, sflagstart, iCompMode)
 If sngStart = 0 Then
  sngReturnedOccurrenceLocation = 0
  extractText = ""
  Exit Function
 End If ' If sngStart = 0 Then
  
 If sflagstart2 <> "" Then
  sOffsetText = sflagstart2
  sngStart = InStr(sngStart, sSource, sflagstart2, iCompMode)
  If sngStart = 0 Then
   sngReturnedOccurrenceLocation = 0
   extractText = ""
   Exit Function
  End If ' If sngStart = 0 Then
 End If ' If sflagstart2 <> "" Then

sngEnd = InStr((sngStart + Len(sOffsetText)), sSource, sflagend, iCompMode)
 If sngEnd = 0 Then
  sngReturnedOccurrenceLocation = 0
  extractText = ""
  Exit Function
 End If ' If sngEnd = 0 Then

sTheText = Mid(sSource, (sngStart + Len(sOffsetText)), sngEnd - sngStart - Len(sOffsetText))
 sngReturnedOccurrenceLocation = CSng((sngStart + Len(sOffsetText)))
 sngPosition = sngEnd + Len(sngEnd)

extractText = sTheText

Exit Function

errh:

MsgBox "extractText(): Error occurred." & vbCr & _
       Err.Number & ": " & Err.Description, vbInformation, "Error occurred"
extractText = ""

End Function