CodeItBetter Programming Another VB Programming Blog

'Miscellaneous - 3 XML (Or HTML) Tag Reading Functions
'The three functions that are here are used to extract information from a XML or
'HTML document. Also, see the project enclosed for examples of how to use them
'
'The first will get the information from between the first set of tags with a
'specified name it encounters.
'
'The call is simple: ReturnFirstElementInstance(strXMLText, strSearchElement)
'
'Where strXMLText is the string containing the XML or HTML text and
'strSearchElement is a string containing the tag name (No < or >'s) to be
'searched for.
'
'The second will get all the information from between all the tags with a
'specified name it encounters: (Seperated by the vbNewLine constant)
'
'The call is simple: ReturnAllElementInstances(strXMLText, strSearchElement)
'
'Where strXMLText is the string containing the XML or HTML text and
'strSearchElement is a string containing the tag name (No < or >'s) to be
'searched for.
'
'The third will get all the information from a specific tag number (From a given
'name)
'
'The call is simple: ReturnSpecificElementInstance(strXMLText, strSearchElement, intTagNumber)
'
'Where strXMLText is the string containing the XML or HTML text and
'strSearchElement is a string containing the tag name (No < or >'s) to be
'searched for. intTagNumber is the tag number to read.
'
Option Explicit
 
Private Sub Form_Load()
    Dim strMyXML As String
    strMyXML = "<good>Here is the first instance of the good element in the document.</good>" _
       + vbNewLine & "<bad>This line should never appear in the results of this test.</bad>" _
       + vbNewLine & "<good>Here is the second instance of the good element in the document!</good>"
    txtMyXML.Text = strMyXML
    txtReturnFirstElementInstance.Text = ReturnFirstElementInstance(txtMyXML.Text, "good")
    txtReturnAllElementInstances.Text = ReturnAllElementInstances(txtMyXML.Text, "good")
    txtReturnSpecificElementInstance.Text = ReturnSpecificElementInstance(txtMyXML.Text, "good", 2)
End Sub
 
Private Function ReturnFirstElementInstance(strDocument As String, strElement As String) As String
    Dim strOpenElement As String
    Dim strCloseElement As String
    Dim intStartPos As Integer
    Dim intElementLength As Integer
    strOpenElement = "<" & strElement & ">"
    strCloseElement = "</" & strElement & ">"
    If InStr(strDocument, strOpenElement) > 0 Then
        intStartPos = InStr(strDocument, strOpenElement) + Len(strOpenElement)
        intElementLength = InStr(strDocument, strCloseElement) - intStartPos
        ReturnFirstElementInstance = Mid$(strDocument, intStartPos, intElementLength)
    End If
End Function
 
Private Function ReturnAllElementInstances(strDocument As String, strElement As String) As String
    Dim strOpenElement As String
    Dim strCloseElement As String
    Dim strTemp As String
    Dim intStartPos As Integer
    Dim intElementLength As Integer
    strOpenElement = "<" & strElement & ">"
    strCloseElement = "</" & strElement & ">"
    If InStr(strDocument, strOpenElement) > 0 Then
        While InStr(strDocument, strOpenElement) > 0
            intStartPos = InStr(strDocument, strOpenElement) + Len(strOpenElement)
            intElementLength = InStr(strDocument$, strCloseElement) - intStartPos
            strTemp = Mid$(strDocument$, intStartPos, intElementLength)
            strDocument = Right$(strDocument, Len(strDocument) - (intStartPos + intElementLength))
            strTemp = strTemp & vbNewLine & strTemp
        Wend
        ReturnAllElementInstances = strTemp
    End If
End Function
 
Private Function ReturnSpecificElementInstance(strDocument As String, strElement As String, intInstance As Integer) As String
    Dim strOpenElement As String
    Dim strCloseElement As String
    Dim strTemp As String
    Dim intIndex As Integer
    Dim intStartPos As Integer
    Dim intElementLength As Integer
    strOpenElement = "<" & strElement & ">"
    strCloseElement = "</" & strElement & ">"
    intIndex = 0
    If InStr(strDocument, strOpenElement) Then
        While InStr(strDocument, strOpenElement) > 0
            intIndex = intIndex + 1
            intStartPos = InStr(strDocument, strOpenElement) + Len(strOpenElement)
            intElementLength = InStr(strDocument, strCloseElement) - intStartPos
            strTemp = Mid$(strDocument, intStartPos, intElementLength)
            strDocument = Right$(strDocument, Len(strDocument) - (intStartPos + intElementLength))
            If intIndex = intInstance Then
                ReturnSpecificElementInstance = strTemp
            End If
        Wend
    End If
End Function