Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to I read and modify an XML file through VBA?

Tags:

xml

vba

I haven't programmed anything in over 15 years, but in the past month I have created an Excel VBA thing for me that someone else wants to use. I was hoping to do something to verify that their license is still active. I was thinking that it could reference an XML file to see if the license is still good and perhaps write to the XML file a couple of things so I know they used it.

Here is my XML file (of course it will be much longer, but this covers it). My goal is to update the XML file when the customer pays. Notice how the file says "August." Come September, the program will not run because the code I enter will not match the September code in the VBA file. Once they pay, I'll update the code in the XML file, then when they run the file, it will work.

I can get it to put the entire XML file in a message box, but I do not know how to search for the agency name then grab the month and code to verify. I think I want the VBA macro to read the XML file, search for Agency Name 2 (for example), when it finds Agency Name 2, grab the date and code. Verify that this date and code match what is expected in the VBA file, then it will allow the rest of the subs to run. Concurrently, I'd like it to put a date, time, and some other stuff back in the XML file as a way to see when they used it last.

I know this isn't great security, since if they can just get past a password they can change the script to avoid this, but it is something.

Below is the XML, and below that is my sub to get me a msgbox of what is inside the XML, but I have no idea how to search or write what I am thinking about above. Please give me some advice.

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<data-set xmlns:xsi="www.example.com /2001/XMLSchema-instance">
<record>
  <Agency>Agency Name 1</Agency>
  <Date>August</Date>
  <Code>code to give</Code>
</record>
<record>
  <Agency>Agency Name 2</Agency>
  <Date>August</Date>
  <Code>code to give</Code>
</record>
</data-set>

Dim xmlhttp As Object
Dim myUrl As String

Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")

myUrl = "www.example.com/myfile.xml"
xmlhttp.Open "Get", myUrl, False
xmlhttp.send

MsgBox (xmlhttp.responsetext)
like image 916
GaryC Avatar asked Aug 18 '18 23:08

GaryC


People also ask

How do I read and edit an XML file?

XML files are encoded in plaintext, so you can open them in any text editor and be able to clearly read it. Right-click the XML file and select "Open With." This will display a list of programs to open the file in. Select "Notepad" (Windows) or "TextEdit" (Mac).


1 Answers

Below is some sample code and a couple of useful links that may help you. I highly recommend single stepping through the code and looking at each object's state as the code progresses.

Also based on a suggestion in a comment you will need to add the reference to the MSXML2 library. In the VBA development window, you click on the Tools Menu and the References... (Tools->References). The references dialog box appears. Scroll down until you find Microsoft XML, v6.0 check the box to add it, click the OK button and you're off to the races.

Some useful links

WC3 Schools XML DOM Tutorial

Microsoft IXMLDOMText Object Members

    Declare and set your URL
    Dim myUrl As String: myUrl = "www.example.com/myfile.xml"

    'Declare your xmlHTTP stream
    'I prefer early binding rather than late binding
    Dim xmlHTTP As MSXML2.ServerXMLHTTP60
    xmlHTTP.Open "Get", myUrl, False
    xmlHTTP.send

   'Use reponseXML rather than responseText
   'This way you get an XML DOM, rather than a string of text
   'Declare XML DOM Document
    Dim xmlDOMDoc As MSXML2.DOMDocument60
    Set xmlDoc = xmlHTTP.responseXML

    'Declare a rootNode as an XML DOM element
    Dim rootNode As MSXML2.IXMLDOMElement

    'Set the root node to the xmlDocumet (your HTTP stream)
    'to the top document element
    'In your case Root Node is data-set
    Set rootNode = xmlDoc.DocumentElement

    'Declare the Root Nodes children.
    'In your case they are XML Element nodes
    'with the name record
    Dim xmlRootChildNode As MSXML2.IXMLDOMElement

    'Your nodes of Root Children are Text Nodes
    'in your example the names are Agency, Date and Code
    Dim xmlChildrenOfRootChildNode As MSXML2.IXMLDOMElement

    'Declare a string array to hold the text in your Text Nodes
    Dim tnText(3) As String
    Dim tnDictionary As Scripting.Dictionary
    Dim nDx As Integer

    'Loop through the Roots children
    For Each xmlRootChildNode In rootNode.ChildNodes
    'does the Root Child Node have children?
            If xmlRootChildNode.HasChildNodes Then
                nDx = 0
                'This code will add them to the array
                For Each xmlChildrenOfRootChildNode In xmlRootChildNode.ChildNodes
                    tnText(nDx) = xmlChildrenOfRootChildNode.text
                Next
                'Or if you want to use a Dictionary
                For Each xmlChildrenOfRootChildNode In xmlRootChildNode.ChildNodes
                    'This adds a record to a Dictionary.  It will contain
                    'The dictionary's key will be the nodeName aka tag (Agency, Date, Code)
                    'The dictionary's item will be the Text value stored between the xml tags
                    tnDictionary.Add xmlChildrenOfRootChildNode.nodeName, xmlChildrenOfRootChildNode.text
                Next
        End If
    Next

Adding carriage return (CR), line feed (LF) and Tab characters to an XLM output file so you can read is a challenge. I didn't find anything online that really helped. Below is code that will insert CRLF and as many tab characters as you need.

The Public enum for directing the method to add white space either after or before the current node:

'Public Enumerator used by the XMLAddSpace function
'This is an indicator telling the function
'where the CRLF and tabs are being added
Public Enum eAddBeforeAfter
    After = 1
    Before = 2
End Enum

The XMLAddSpace Function:

    '*****************************************************************************************
'**                                                                                     **
'** Sub XmlAddSpace adds Carriage Return (CR), and Line Feed (LF) and as many tab       **
'**     characters specificed in tabCnt.  It used vbCrLf for the CR and LF value and    **
'**     Chr(9) (ASCII Tab Character value 09) to set the ASCII tab character value.     **
'**                                                                                     **
'**     PARAMATERS:                                                                     **
'**         xmlNode as IXMLDOMElement Is the Node that the white space will be added    **
'**         after.                                                                      **
'**         tabCnt is the number of tab characters you want to indent the next line by  **
'**         BeforeAfter is an enum that directs the method to either add the white      **
'**             before the xmlChildNode or after the xmlNode                            **
'**         xmlChildNode is optional when selecting After but required when selecting   **
'**             Before for adding white space before a node. White space is always      **
'**             before a child node element                                             **
'*****************************************************************************************
Public Sub XmlAddSpace(ByRef xmlNode As MSXML2.IXMLDOMElement, ByVal tabCnt As Integer, _
                       ByVal BeforeAfter As eAddBeforeAfter, Optional ByRef xmlChildNode As MSXML2.IXMLDOMElement)

    'Declare the text node that will hold the white space text
    Dim nodeSpace As IXMLDOMText
    'Declare a variable to hold the white space text
    'We'll add the tab characters in the next few statements
    'Start by putting CRLF as the front of the text string
    Dim tabSpace As String: tabSpace = vbCrLf

    'Now add the tab character to the string after CRLF
    'this way the XML output has a new line follwed by 0 to n
    'number of tab characters causing it to indent
    If tabCnt > 0 Then
        Dim i As Integer
        For i = 1 To tabCnt
            tabSpace = tabSpace & Chr(9)
        Next
    End If

    'Now add the white space to the text node.
    If BeforeAfter = After Then
        'After puts white space after the current node
        'This is useful for putting CRLF and indenting
        'a parent node's closing tag
        Set nodeSpace = xmlNode.OwnerDocument.createTextNode(tabSpace)
        xmlNode.appendChild nodeSpace
    Else
        'Before puts white space before the current node
        'This is useful for putting CRLF and indenting
        'a new child from either a parent node or a sibling node
        xmlNode.InsertBefore xmlChildNode.OwnerDocument.createTextNode(tabSpace), xmlChildNode
        xmlNode.appendChild xmlChildNode
    End If
End Sub

To use the method you need to call it as follows:

To add before: XmlAddSpace parentNode, 2, Before To add after: XmlAddSpace parentNode, 2, After, childNode

Note both parent and child node must be of type MSXML2.IXMLDOMElement

like image 89
Jamie Riis Avatar answered Oct 15 '22 11:10

Jamie Riis