You are here: Home » VBA » MSXML Object Library Routines

MSXML Object Library Routines

If you were directed to this page, it means that you need to copy and paste one or more of the following procedures into a standard module in the same project as the code you are working on. I've placed the code here to avoid having to duplicate it on every page that shows how to consume some web API's XML (or HTML) response.

+ Get XMLHTTP Object
+ Return a particular node from a node tree
+ Return all the child nodes of a given node
+ Get the root node of a XML Document
+ Check if a parsing error occurred when loading a XML document
+ Create a new file using string contents
+ Remove and replace accent characters from a string
+ Replace escaped HTML brackets
+ Create a MSXML DOM Document
+ Create a HTML DOM Document
+ Clear temp file cache
+ Use MSXML Writer
+ Create XML Files
+ Read XML Files
+ URL Encoding
+ MSXML Class Module
+ Get Response from Website
+ MSXML Class Library DLL

Note that there are three sets of procedures:

  • A list of procedures that may be placed in a standard module,
  • A class module you can download and import into your project, and
  • A DLL you install and reference in your code.

You may not need all of these procedures for the particular API or XML you're consuming. Copy and paste as needed, or copy the whole thing into a standard module and remove what you don't need.

Several of the functions assume you are using MSXML 6.0 which is located at %windir%\system32\msxml6.dll. If you are using a different version, change "6.0" to the version you need.

Get XMLHTTP Object

Function GetMSXML() As Object  '  MSXML2.XMLHTTP60
 On Error Resume Next
  Set GetMSXML = CreateObject("MSXML2.XMLHTTP.6.0")
End Function

Return a particular node from a node tree

Function GetNode(parentNode As Object, nodeNumber As Long) As Object
  On Error Resume Next
  ' if parentNode is a MSXML2.IXMLDOMNodeList
 Set GetNode = parentNode.item(nodeNumber - 1)

  ' if parentNode is a MSXML2.IXMLDOMNode
 If GetNode Is Nothing Then
    Set GetNode = parentNode.childNodes(nodeNumber - 1)
  End If
End Function

Return all the child nodes of a given node

Public Function GetChildNodes(node As Object) As Object
' returns child nodes for a given MSXML2.IXMLDOMNode
 Set GetChildNodes = node.childNodes
End Function

Get the root node of a XML Document

Function GetRootNode(xmlDoc As Object) As Object
' returns root node
 Set GetRootNode = xmlDoc.documentElement
End Function

Check if a parsing error occurred when loading a XML document

Function LoadError(xmlDoc As Object) As Boolean
' checks if a xml file load error occurred
 LoadError = (xmlDoc.parseError.errorCode <> 0)
End Function

Create a new file using string contents

Function CreateFile(fileName As String, contents As String) As String
' creates file from string contents

Dim tempFile As String
Dim nextFileNum As Long

  nextFileNum = FreeFile
  tempFile = fileName

  Open tempFile For Output As #nextFileNum
  Print #nextFileNum, contents
  Close #nextFileNum

  CreateFile = tempFile
End Function

Remove and replace accent characters from a string

Function ConvertAccent(ByVal inputString As String) As String
' http://www.vbforums.com/archive/index.php/t-483965.html

Const AccChars As String = _
      "²—­–ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ’"
Const RegChars As String = _
      "2---SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy'"

Dim i As Long, j As Long
Dim tempString As String
Dim currentCharacter As String
Dim found As Boolean
Dim foundPosition As Long

  tempString = inputString

  ' loop through the shorter string
 Select Case True
    Case Len(AccChars) <= Len(inputString)
      ' accent character list is shorter (or same)
     ' loop through accent character string
     For i = 1 To Len(AccChars)

        ' get next accent character
       currentCharacter = Mid$(AccChars, i, 1)

        ' replace with corresponding character in "regular" array
       If InStr(tempString, currentCharacter) > 0 Then
          tempString = Replace(tempString, currentCharacter, _
                               Mid$(RegChars, i, 1))
        End If
      Next i
    Case Len(AccChars) > Len(inputString)
      ' input string is shorter
     ' loop through input string
     For i = 1 To Len(inputString)

        ' grab current character from input string and
       ' determine if it is a special char
       currentCharacter = Mid$(inputString, i, 1)
        found = (InStr(AccChars, currentCharacter) > 0)

        If found Then

          ' find position of special character in special array
         foundPosition = InStr(AccChars, currentCharacter)

          ' replace with corresponding character in "regular" array
         tempString = Replace(tempString, currentCharacter, _
                               Mid$(RegChars, foundPosition, 1))

        End If
      Next i
  End Select

  ConvertAccent = tempString
End Function

Replace escaped HTML brackets

Some XML responses will convert "<" and ">" to their escaped equivalents. We can't parse that in MSXML without first converting them back.

Function FixAngleBrackets(textString As String) As String
  FixAngleBrackets = Replace(Replace(textString, "&lt;", "<"), "&gt;", ">")
End Function

Create a MSXML DOM Document

Function GetDomDoc() As Object  ' MSXML2.DOMDocument
 On Error Resume Next
  Set GetDomDoc = CreateObject("MSXML2.DOMDocument.6.0")
End Function

Create a HTML DOM Document

Function CreateHTMLDoc() As Object ' MSHTML.HTMLDocument
  On Error Resume Next
  Set CreateHTMLDoc = CreateObject("htmlfile")
End Function

Clear temp file cache

Defaults to .xml files, but you can pass in any file extension and those files in the local temp folder with that extension will be deleted.

Function ClearCache(Optional fileExtension As String = "xml")
' deletes stored xml files from temp folder
Dim filesToDelete As String
  filesToDelete = Environ("temp") & "\*." & fileExtension
  Kill filesToDelete
End Function

Use MSXML Writer

Function GetMXXMLWriter() As Object
  On Error Resume Next
  Set GetMXXMLWriter = CreateObject("MSXML2.MXXMLWriter.6.0")
End Function

Create XML Files

See Create XML Files Using DOM for usage example.

Function CreateXML(inputValues As Variant, _
                   Optional filePath As String, _
                   Optional parentNodeName As String = "Values", _
                   Optional returnXML As Boolean = 1) As String
' see http://www.jpsoftwaretech.com/create-xml-files-using-dom/
' validated using http://validator.w3.org/
  Dim pathName As String
  Dim xmlDoc As Object  ' MSXML2.DOMDocument60
  Dim mxxml As Object  ' MSXML2.MXXMLWriter60
  Dim cnth As Object  ' MSXML2.IVBSAXContentHandler
  Dim i As Long, j As Long

  ' create new DOM Document and point XML writer to it
  Set xmlDoc = GetDomDoc

  If xmlDoc Is Nothing Then
    MsgBox "Could not create MSXML DOM Document."
    Exit Function
  End If

  Set mxxml = GetMXXMLWriter
  If mxxml Is Nothing Then
    MsgBox "Could not create MXXML Writer"
    Exit Function
  End If

  Set cnth = mxxml
  mxxml.output = xmlDoc
  mxxml.indent = True

  ' begin creating the XML document output
  cnth.startDocument
  ' add xml declaration
  cnth.processingInstruction "xml", "version='1.0' encoding='UTF-8'"

  ' create parent node using input name or default of "Values"
  cnth.startElement "", "", parentNodeName, Nothing

  ' create first-level child nodes using first row of array
  For i = LBound(inputValues, 2) To UBound(inputValues, 2)
    cnth.startElement "", "", CStr(inputValues(1, i)), Nothing
    ' loop through array and create a child node for each
    ' since parent node hasn't been closed, these will automatically be child nodes
    For j = 2 To UBound(inputValues)
      cnth.startElement "", "", "Value", Nothing
      cnth.Characters CStr(inputValues(j, i))
      cnth.endElement "", "", "Value"
    Next j
    ' close parent node
    cnth.endElement "", "", CStr(inputValues(1, i))
  Next i

  ' close parent node
  cnth.endElement "", "", parentNodeName
  ' end output
  cnth.endDocument

  ' save xml?
  If Len(filePath) > 0 Then
    ' verify folder exists
    pathName = Split(filePath, ExtractFileName(filePath))(0)
    If FolderExists(pathName) Then
      ' save xml to specified filepath
      xmlDoc.Save filePath
    End If
  Else  ' return xml
    returnXML = 1
  End If

  ' return xml?
  If returnXML Then
    CreateXML = xmlDoc.xml
  End If

End Function

Read XML Files

See Read XML Files Using DOM for usage example.

Function ReadXML(fileName As String) As String()
' see http://www.jpsoftwaretech.com/read-xml-files-using-dom/
  Dim xmlDoc As Object  ' MSXML2.DOMDocument60
  Dim myvalues As Object  ' MSXML2.IXMLDOMNode
  Dim values As Object  ' MSXML2.IXMLDOMNode
  Dim value As Object  ' MSXML2.IXMLDOMNode
  Dim tempString() As String
  Dim numRows As Long, numColumns As Long
  Dim i As Long, j As Long

  ' check if file exists
  If Len(Dir(fileName)) = 0 Then Exit Function

  ' create MSXML 6.0 document and load existing file
  Set xmlDoc = GetDomDoc
  If xmlDoc Is Nothing Then Exit Function
  xmlDoc.Load fileName
  If LoadError(xmlDoc) Then Exit Function

  ' second node starts the node tree
  Set myvalues = GetNode(xmlDoc, 2)
  ' array size? add +1 for header row
  numColumns = myvalues.childNodes.Length
  numRows = GetNode(myvalues, 1).childNodes.Length + 1
  ReDim tempString(1 To numColumns, 1 To numRows)

  For i = 1 To numColumns
    Set values = GetNode(myvalues, i)
    ' first value in every column is node name
    tempString(i, 1) = values.nodeName

    For j = 1 To numRows - 1
      tempString(i, j + 1) = GetNode(values, j).nodeTypedValue
    Next j

  Next i

  ReadXML = tempString

End Function

URL Encoding

You may also need to urlencode your URLs. This is so they can be passed to the API. I use something I found on Free VB Code: URLEncode for Large Strings.

MSXML Class Module

I've placed these procedures into a class module for your convenience. Simply download and import the .cls file into your VBA project.

Download .cls file for import

To use the class module, first instantiate the clsMSXML class like this:

  Dim msxml As clsMSXML
  Set msxml = New clsMSXML

Now you can use any of the above functions as native methods of the object you created. Ex:

Sub TestclsMSXML()
  Dim msxml As clsMSXML
  Dim xml As Object ' MSXML2.XMLHTTP60
  Dim fileName As String
  Dim cleanText As String
  Dim htmlDoc As Object ' MSHTML.HTMLDocument
  Dim cleanUrl As String

  Set msxml = New clsMSXML
  ' get the XMLHTTP object
  Set xml = msxml.GetMSXML
  ' scrape the source of google.com
  With xml
    .Open "GET", "http://www.google.com/", False
    .send
  End With

  ' remove accent characters
  cleanText = msxml.ConvertAccent(xml.responseText)
  ' fix angle brackets if they are messed up in XML
  cleanText = msxml.FixAngleBrackets(xml.responseText)
  ' save html source to disk
  fileName = msxml.CreateFile("C:\websitecontents.txt", cleanText)

  ' create HTML DOM Document and populate it with source from google.com
  Set htmlDoc = msxml.CreateHTMLDoc
  htmlDoc.body.innerHTML = cleanText
  ' urlencode a URL
  cleanUrl = msxml.URLEncode("http://www.jpsoftwaretech.com")
End Sub

The URL encoding function I linked to has been included in the class module.

The class module assumes you are using MSXML 6.0 which is located at %windir%\system32\msxml6.dll. If you are using a different version, simply open the class module and change the VERSION constant. For example, if you are using msxml2.dll, change VERSION to "". If you are using msxml4.dll, change VERSION to "4.0".

Get Response from Website

Makes GET, HEAD or POST requests to any website, form or API and return the web response as a string. Paste the following at the top of a standard module. If you download the class module, this code is already included.

Public Enum HTTPRequestType
  HTTP_GET
  HTTP_POST
  HTTP_HEAD
End Enum

Private Function GetRequestType(reqType As HTTPRequestType) As String
' translate enum into string
  Select Case reqType
  Case 1
    GetRequestType = "POST"
  Case 2
    GetRequestType = "HEAD"
  Case Else  ' GET is default
    GetRequestType = "GET"
  End Select
End Function

After creating the MSXML.XMLHTTP object, call the following function. This is basically an encapsulation of the XMLHTTP.Open and XMLHTTP.Send methods.

Function GetResponse(xml As Object, _
                        requestType As HTTPRequestType, _
                        destinationURL As String, _
                        Optional async As Boolean, _
                        Optional requestHeaders As Variant, _
                        Optional postContent As String) As String

  Dim reqType As String
  Dim response As String
  Dim i As Long

  ' translate enum into string
  reqType = GetRequestType(requestType)

  ' open request
  With xml
    .Open reqType, destinationURL, async

    ' check for headers
    If Not IsMissing(requestHeaders) Then
      If Not IsEmpty(requestHeaders) Then
        For i = LBound(requestHeaders) To UBound(requestHeaders)
          .setRequestHeader requestHeaders(i, 1), requestHeaders(i, 2)
        Next i
      End If
    End If

    ' if HTTP POST, need to send contents, will not 
    ' harm GET or HEAD requests
    .send postContent

    ' if HEAD request, return headers, not response
    If reqType = "HEAD" Then
      response = xml.getAllResponseHeaders
    Else
      response = xml.responsetext
    End If

  End With

  GetResponse = response
End Function

Sample Usage

Using the class module, a GET request would now look like this. This technique may be used for screen scraping, assigning the source of a webpage to a HTML document, and so on.

Sub TestGET()

  Dim msxml As clsMSXML
  Dim xml As Object
  Dim response As String

  Set msxml = New clsMSXML
  Set xml = msxml.GetMSXML
  ' sample GET request
  response = msxml.GetResponse(xml, HTTP_GET, "http://www.google.com/")

End Sub

A HEAD request returns the response headers from a given website back to the calling procedure.

Sub TestHEAD()

  Dim msxml As clsMSXML
  Dim xml As Object
  Dim response As String

  Set msxml = New clsMSXML
  Set xml = msxml.GetMSXML
  ' sample HEAD request
  response = msxml.GetResponse(xml, HTTP_HEAD, "http://www.google.com/")

End Sub

A POST request may require specific headers as well as content to be POST'ed to a given URL. This example uses code from Another way to hide your email to issue a POST request to a web API.

The request headers are set up in a 2D array, while the content to be POST'ed is concatenated into a single string.

Sub TestPOST()
  Dim msxml As clsMSXML
  Dim xml As Object
  Dim response As String
  Dim reqHeaders As Variant

  Set msxml = New clsMSXML
  Set xml = msxml.GetMSXML

  ' set up request headers for API
  ReDim reqHeaders(1 To 1, 1 To 2)
  reqHeaders(1, 1) = "Content-Type"
  reqHeaders(1, 2) = "application/x-www-form-urlencoded"

  ' sample POST request
  With msxml
    response = .GetResponse(xml, HTTP_POST, "http://scr.im/xml/", , _
       reqHeaders, "email=" & .URLEncode("yourname@emailaddress.com"))
  End With

End Sub

MSXML Class Library DLL

I've created a DLL in VB6 that uses these same functions. MSXML 6.0 is required. Download the installer and you can use these functions in any VBA-aware program such as Outlook, Word, Excel.

Download DLL installer

Sample Usage

Usage is similar to the class module. You can set an early bound reference to the DLL like this:

VBA References

Then you can declare your main object like this:

Dim msxmlcl As MSXMLClassLib.msxmlcl

If you want late bound code, simply declare As Object. To use the GetResponse method:

Dim msxmlcl As MSXMLClassLib.msxmlcl ' or "As Object" if late bound
Dim msxml As Object ' MSXML2.XMLHTTP60
Dim result As String

Set msxmlcl = CreateObject("MSXMLClassLib.msxmlcl")
Set msxml = msxmlcl.GetMSXML

result = msxmlcl.GetResponse(msxml, HTTP_GET, "http://www.google.com/", False)

View the README.TXT for instructions on uninstalling the DLL.

Site last updated: May 21, 2013

Excel School