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)
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).
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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With