我已经 15 年没有编写任何程序了，但在过去的一个月里，我为自己创建了一个 Excel VBA 东西，其他人也想使用它。我希望做些事情来验证他们的许可证是否仍然有效。我在想它可以引用一个 XML 文件来查看许可证是否仍然有效，也许可以向 XML 文件写入一些东西，这样我就知道他们使用了它。

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

我可以将整个 XML 文件放在消息框中，但我不知道如何搜索机构名称然后获取月份和代码来验证。我想我想让 VBA 宏读取 XML 文件，搜索机构名称 2(例如)，当它找到机构名称 2 时，获取日期和代码。验证此日期和代码是否与 VBA 文件中的预期匹配，然后它将允许其余的子程序运行。同时，我希望它能将日期、时间和其他一些内容放回到 XML 文件中，作为查看他们上次使用它的时间的一种方式。

我知道这不是很好的安全措施，因为如果他们可以通过密码，他们就可以更改脚本来避免这种情况，但这是很重要的。

下面是 XML，下面是我的子程序，用于获取 XML 内部内容的消息框，但我不知道如何搜索或编写我上面所想的内容。请给我一些建议。

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

最佳答案

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

另外，根据评论中的建议，您需要添加对 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

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

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

'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 类型

关于xml - 如何通过 VBA 读取和修改 XML 文件？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/51913313/