TopXML Uncategorized library : XML Helper functions in Visual Basic

Home Page

Add/Edit your code items

Search the code library

Browse for the code library

Uncategorized
Uncategorized
Uncategorized Contents
nodeset of child templates using document()
Converting INI files to XML
Fullxml 2
Sorting the results and use the Axis
TreeMaker
XMLEditor - WebClipping
WDDX Parser
Templx: x++ IDE Released!
XppEngCOM: COM implementation of x++ interpreter
Backup Outlook mail as XML
Grouping and Summing the values in XML
WDDX Parser (updated bug)
DIME Parser and Generator (C#)
Flash menu using XML
Virtual Directory Utilities for IIS(C#)
ComSerialization
Re: Max() function
Stop Tailoring, Create Generic!!!
Introduction to WAP Push
Add xml binding to select list

<< System.XML WCF, WS, SOAP >>

By	Grant Phillips
First Posted	03/21/2002
Times viewed	262

XML Helper functions in Visual Basic

Summary Handy VB functions for manipulating XML.

' Create an XML node (as a string) with some attributes, eg.
' strXML = XMLCreate( Person, Array( ma(Name, Bob Smith), ma(Age, 36) ) )
Public Function XMLCreate( _
ByVal strNodeName As String, _
Optional varAttributes As Variant) As String

' Get the value of an xml attribute from an XML Node
Public Function XMLGetAttributeValue( _
ByRef xmlNode As IXMLDOMNode, _
ByVal strAttributeName As String, _
Optional ByVal varDefault As Variant) As Variant

' Get the boolean value of an xml attribute from an XML Node
Public Function XMLGetAttributeValueBoolean( _
ByRef xmlNode As IXMLDOMNode, _
ByVal strAttributeName As String, _
Optional ByVal blnDefault As Boolean = False) As Boolean

' Get the long value of an xml attribute from an XML Node
Public Function XMLGetAttributeValueLong( _
ByRef xmlNode As IXMLDOMNode, _
ByVal strAttributeName As String, _
Optional ByVal lngDefault As Long = 0) As Long

' Create and Load an XML Document from either a string or a file, eg.
' Set xmlDoc1 = XMLLoadDoc( sample.xml )
' Set xmlDoc2 = XMLLoadDoc( <Root>Hello</Root> )
Public Function XMLLoadDoc(ByVal strXML As String) As DOMDocument

Additional information
Option Explicit ' XML Constants Public Const XML_Header = "<?xml version=""1.0""?>" Public Const XML_NODE_Root_Open = "<Root>" Public Const XML_NODE_Root_Close = "</Root>" ' ' ma is short for MakeAttribute - does typesafe array creation for use with XML functions Public Function ma( _ ByVal strName As String, _ ByVal varValue As Variant) ma = Array(strName, varValue) End Function Public Function XMLGetAttributeValue( _ ByRef xmlNode As IXMLDOMNode, _ ByVal strAttributeName As String, _ Optional ByVal varDefault As Variant) As Variant On Error GoTo errorHandler XMLGetAttributeValue = xmlNode.Attributes.getNamedItem(strAttributeName).Text Exit Function errorHandler: XMLGetAttributeValue = varDefault End Function Public Function XMLGetAttributeValueBoolean( _ ByRef xmlNode As IXMLDOMNode, _ ByVal strAttributeName As String, _ Optional ByVal blnDefault As Boolean = False) As Boolean Dim varValue As Variant Dim blnRet As Boolean Dim strValue As String XMLGetAttributeValueBoolean = blnDefault varValue = XMLGetAttributeValue(xmlNode, strAttributeName, CStr(blnDefault)) blnRet = blnDefault Select Case Left(UCase(CStr(varValue)), 1) Case "1", "Y", "T" blnRet = True End Select XMLGetAttributeValueBoolean = blnRet End Function Public Function XMLGetAttributeValueLong( _ ByRef xmlNode As IXMLDOMNode, _ ByVal strAttributeName As String, _ Optional ByVal lngDefault As Long = 0) As Long Dim varValue As Variant Dim lngRet As Long XMLGetAttributeValueLong = lngDefault varValue = XMLGetAttributeValue(xmlNode, strAttributeName, lngDefault) lngRet = CLng(varValue) XMLGetAttributeValueLong = lngRet End Function Private Function XMLCollectAttributes(ByVal varAttributes As Variant) As String Dim attrs As Variant Dim varValue As Variant Dim i As Integer Dim l As Integer Dim u As Integer Dim strRet As String XMLCollectAttributes = "" ' No need to do anything if attrs is empty, or is not an array If IsEmpty(varAttributes) Or Not IsArray(varAttributes) Then Exit Function End If attrs = varAttributes For i = LBound(attrs) To UBound(attrs) l = LBound(attrs(i)) u = UBound(attrs(i)) ' should be 2 items in the sub-array If u - l = 1 Then varValue = IIf(IsNull(attrs(i)(1)), "", attrs(i)(1)) strRet = strRet & " " & attrs(i)(0) & "=""" & varValue & """" Else Err.Raise 1, "XMLHelper", "XMLCollectAttributes(...): incorrect # of items (" & ((u - l) + 1) & ") in the array, should be 2" End If Next i XMLCollectAttributes = strRet End Function Public Function XMLCreate( _ ByVal strNodeName As String, _ Optional varAttributes As Variant) As String Dim strXML As String Dim strAttributes As String strAttributes = XMLCollectAttributes(varAttributes) strXML = XML_Header & XML_NODE_Root_Open & _ "<" & strNodeName & _ strAttributes & _ "/>" & _ XML_NODE_Root_Close XMLCreate = strXML End Function ' Loads an XML string into a DOMDocument ' Creates and returns the loaded DOMDocument Public Function XMLLoadDoc(ByVal strXML As String) As DOMDocument Dim xmlDoc As DOMDocument Dim strErrorDesc As String Dim lngErrorCode As Long Set XMLLoadDoc = Nothing Set xmlDoc = New DOMDocument With xmlDoc .async = False If InStr(1, strXML, "<") > 0 Then ' load the XML string .loadXML strXML Else ' Load the XML file .Load strXML End If End With With xmlDoc.parseError If .errorCode <> 0 Then lngErrorCode = .errorCode strErrorDesc = "Problem parsing the XML" & vbCrLf & _ "Reason: " & .reason & vbCrLf & _ "srcText: (" & Len(strXML) & " chars) " & .srcText & vbCrLf & _ "filePos: " & .filepos & vbCrLf & _ "line: " & .Line & vbCrLf & _ "linePos: " & .linepos & vbCrLf & _ "url: " & .url & vbCrLf & _ "errorCode: " & .errorCode Set xmlDoc = Nothing ' Problem parsing the XML Err.Raise lngErrorCode, "XMLHelper.XMLLoadDoc", strErrorDesc Exit Function End If End With Set XMLLoadDoc = xmlDoc End Function

Further additional information
' Example of using the XMLLoadDoc function Private Sub btnXMLLoadDoc_Click() On Error GoTo HandleError Dim xmlDoc As DOMDocument Dim strErr As String Set xmlDoc = XMLLoadDoc(Me.txtXMLSource.Text) Me.txtXMLDestination.Text = xmlDoc.xml Set xmlDoc = Nothing MsgBox "XML Document loaded successfully", vbInformation, Me.Caption Exit Sub HandleError: strErr = "An error occurred:" & vbCrLf & _ "Number : " & Err.Number & vbCrLf & _ "Source : " & Err.Source & vbCrLf & _ Err.Description MsgBox strErr, vbExclamation, "XMLLoadDoc Failed" Me.txtXMLDestination.Text = strErr End Sub

Rate this article on a scale of 1 to 10 (0 votes, average 0)

Your vote :

<< System.XML WCF, WS, SOAP >>


Leave a comment for this article
Your name
Your email (optional)
Your comment
Optional: Upload an attachment
Enter the code shown:



	Recent Jobs A great opportunity to Digital Video Eng here is a greate opportunity as a SMS En A great opportunity as a Network Enginee A Greate Opportunituy as a SQL Developer An immediate job opportunity as a Biztal View all Jobs (Add yours) View all CV (Add yours)

	swimming pool builder chicago web site design online fax Cheap Web Hosting online faxing Giorgio armani sunglasses answering service

	Partners Dream.In.Code dotNet Slackers dotNet Spider Your HTML Source VisualBuilder.com DevGuru Planet Source Code ZVON.ORG Web Design ASPAlliance XML Pitstop Scripts The Spot 4 SAP Bitshop Web Hosting

Email TopXML