<?xml version="1.0" encoding="utf-8"?>
<AppList Name="TEST">
<App id="1">
<standard>
<Name>Microsoft Office Word 2003</Name>
<Path>aaaaaaa</Path>
</standard>
</App>
<App id="2">
<standard>
<Name>Microsoft Office excel 2003</Name>
<Path>bbbbbbb</Path>
</standard>
</App>
<App id="3">
<standard>
<Name>heloo</Name>
<Path>cc</Path>
</standard>
</App>
<User>mu</User>
</AppList>
假设在excel中通过vba取得如上XML文件，并将<App id="2">和<App id="3">下面的 Name和 Path内容写到一个新创建的csv文件中。
小弟，没有用过 VBA不懂究竟，希望大家可以不吝赐教给出代码，如果能再加以说明就万分感激了。谢谢！！！
------解决方案--------------------------------------------------------
- VB code
Sub GetData() Dim Arr, k%, Str$ Workbooks.OpenXML (Application.GetOpenFilename("xml文件,*.xml", , "请选择", , False)) Arr = ActiveWorkbook.ActiveSheet.Range("B4:D5") ActiveWorkbook.Close False For k = 1 To UBound(Arr) Str = Str & Join(Application.Index(Arr, k), ",") & vbCrLf Next Open ThisWorkbook.Path & "\test.csv" For Output As #1 Print #1, Str ResetEnd Sub
------解决方案--------------------------------------------------------
1. 直接读XML的APP节点。
2. 然后写文本文件，实际上csv就是文本文件。
------解决方案--------------------------------------------------------
- VB code
Sub GetXmlData() Dim xmlfile '-------------xml文件名称 xmlfile = Application.GetOpenFilename("xml文件,*.xml", , "请选择", , False) '----------未选择xml文件 If xmlfile = False Then MsgBox "未选择xml文件，请重新运行程序！", vbInformation + vbOKOnly, "加载提示" Exit Sub End If Dim tmpstr As String tmpstr = "App_id,Name,Path" '-----------csv文件头，类似表头 '------------定义xmldocument对象、Nodelist、node/element Dim xmldoc As MSXML2.DOMDocument Dim myNode As IXMLDOMElement Dim nd1 As IXMLDOMElement Dim nd2 As IXMLDOMElement Dim nd3 As IXMLDOMElement Dim xmlNodeList As IXMLDOMNodeList Set xmldoc = New MSXML2.DOMDocument '--------为了保证读取xml成功，设置xmldoc的一些属性 xmldoc.resolveExternals = False xmldoc.validateOnParse = False xmldoc.async = False '----------加载不成功，就直接退出 If Not xmldoc.Load(xmlfile) Then MsgBox "xml文件格式不正确，不能正确读取xml文件，请检查xml文件格式！", vbCritical + vbOKOnly, "加载提示" Set xmldoc = Nothing Exit Sub End If Set xmlNodeList = xmldoc.getElementsByTagName("App") '------获取App节点列表 '---------------读取xml中的要求的内容 If Not (xmlNodeList Is Nothing) Then For Each myNode In xmlNodeList If myNode.getAttribute("id") <> "1" Then Set nd1 = myNode.SelectSingleNode("standard") Set nd2 = nd1.SelectSingleNode("Name") Set nd3 = nd1.SelectSingleNode("Path") tmpstr = tmpstr & vbCrLf & myNode.getAttribute("id") & "," _ & nd2.Text & "," & nd3.Text End If Next myNode End If '------------写文件 On Error GoTo Er1: Open ThisWorkbook.Path & "\test.csv" For Output As #1 Print #1, tmpstr Reset '------------关闭文件 Set xmldoc = Nothing Set nd1 = Nothing Set nd2 = Nothing Set nd3 = Nothing Set myNode = Nothing Set xmlNodeList = Nothing MsgBox "生成csv文件成功！", vbInformation + vbOKOnly, "提示" Exit SubEr1: MsgBox "文件占用，无法写csv文件！", vbInformation + vbOKOnly, "提示" Exit SubEnd Sub