如何通过VBA读取和修改XML文件?

时间:2018-08-18 23:38:07

标签: xml vba

我已经15年没有编程任何东西了,但是在过去的一个月中,我为我创建了一个Excel VBA东西,供其他人使用。我希望能做些事情来验证他们的许可证仍然有效。我当时在想,它可以引用XML文件以查看许可证是否仍然有效,并可能将一些内容写入XML文件,因此我知道他们使用了它。

这是我的XML文件(当然会更长,但这涵盖了它)。我的目标是在客户付款时更新XML文件。请注意文件中显示的是“八月”。到了9月,该程序将无法运行,因为我输入的代码与VBA文件中的9月代码不匹配。一旦他们付款,我将更新XML文件中的代码,然后当他们运行该文件时,它将起作用。

我可以将整个XML文件放在一个消息框中,但是我不知道如何搜索代理商名称,然后获取月份和代码以进行验证。我想我希望VBA宏读取XML文件,例如,在找到“代理名称2”时搜索“代理名称2”,以获取日期和代码。验证此日期和代码是否与VBA文件中的预期值匹配,然后它将允许其余的子程序运行。同时,我希望它可以将日期,时间和其他一些东西放回XML文件中,以查看他们最后一次使用它的时间。

我知道这不是一个很好的安全性,因为如果他们只能通过密码,就可以更改脚本来避免这种情况,但这是可以的。

下面是XML,下面是让我了解XML内在内容的msgbox的子项,但是我不知道如何搜索或编写上面所考虑的内容。请给我一些建议。

<?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)

1 个答案:

答案 0 :(得分:2)

下面是一些示例代码和一些有用的链接,它们可能会对您有所帮助。我强烈建议您单步执行代码并在代码进行过程中查看每个对象的状态。

还基于注释中的建议,您需要将引用添加到MSXML2库。在VBA开发窗口中,单击“工具”菜单和“参考...”(“工具”->“参考”)。出现引用对话框。向下滚动,直到找到Microsoft XML, v6.0复选框以将其添加,然后单击“确定”按钮,即可开始比赛。

一些有用的链接

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

在XLM输出文件中添加回车符(CR),换行符(LF)和制表符,以便您阅读是一个挑战。我在网上找不到任何真正有用的东西。下面是将插入CRLF和所需的任意制表符的代码。

用于指示方法在当前节点之后或之前添加空白的公共枚举:

'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

XMLAddSpace函数:

    '*****************************************************************************************
'**                                                                                     **
'** 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

要使用该方法,您需要按以下方式调用它:

要添加之前:XmlAddSpace parentNode, 2, Before 要在之后添加:XmlAddSpace parentNode, 2, After, childNode

请注意,父节点和子节点都必须为MSXML2.IXMLDOMElement类型

相关问题