如何用VB操作Excel转换为XML格式（介绍资料也有分）

Question

对于EXCEL文件的内容，希望按照一定格式转换为xml文件，EXCEL内容例如：Voucher_Id Oper Entry_Id ZhaiYao Acc_Code JieFang DaiFang fName1 fNeiRong1 fName2 fNeiRong2
1 Admin 1 测试摘要 540401 1000 部门 02005 项目工程 02005001
1 Admin 2 测试摘要 100101 1000
2 Admin2 1 测试摘要2 540402 900 部门 02005 项目工程 02005001
2 Admin2 2 测试摘要2 100101 900 转换为xml文件的内容为：
<?xml version="1.0" encoding="gb2312"?>
<interface>
<voucher id="">
<voucher_head>
<Voucher_Id>1</Voucher_Id>
<Oper>Admin</Oper>
</voucher_head>
<voucher_body>
<entry>
<Entry_id>1</Entry_id>
<ZhaiYao>测试摘要</ZhaiYao>
<acc_code>540401</acc_code>
<jiefang>1000</jiefang>
<daifang>0</daifang>
<auxiliary_accounting>
<item name="部门">02005</item>
<item name="项目工程">02005001</item>
</auxiliary_accounting>
</entry>
<entry>
<Entry_Id>2</Entry_Id>
<ZhaiYao>测试摘要</ZhaiYao>
<Acc_Code>100101</Acc_Code>
<JieFang>0</JieFang>
<DaiFang>1000</DaiFang>
</entry>
</voucher_body>
</voucher>
<voucher id="">
<voucher_head>
<Voucher_Id>2</Voucher_Id>
<Oper>Admin2</Oper>
</voucher_head>
<voucher_body>
<entry>
<Entry_id>1</Entry_id>
<ZhaiYao>测试摘要2</ZhaiYao>
<acc_code>540402</acc_code>
<jiefang>900</jiefang>
<daifang>0</daifang>
<auxiliary_accounting>
<item name="部门">02005</item>
<item name="项目工程">02005001</item>
</auxiliary_accounting>
</entry>
<entry>
<Entry_Id>2</Entry_Id>
<ZhaiYao>测试摘要2</ZhaiYao>
<Acc_Code>100101</Acc_Code>
<JieFang>0</JieFang>
<DaiFang>900</DaiFang>
</entry>
</voucher_body>
</voucher>
</interface>说明：一直不懂DOM中Node的操作，有没有熟悉Node操作的，介绍一下全面的资料？在网上查找的都是只言片语，只要调试就错误百出，……
这个实现好像很复杂的样子，只要给参考资料的，都送分，万分感激……
下面是excel截图的效果：Voucher_Id和Oper相当于voucher_head部分（浅绿色标记）；
Entry_Id----fNeiRong2是voucher_body部分，每一行成为一个entry；
难点是fName1----fNeiRong2属于auxiliary_accounting部分，如果一行完全没有内容就空出来，如果是一个，就保留一个

Answer 1

excel中有直接的另存为。你如果要自己定义的多，那么就读取excel一行行处理写入文件吧

Answer 2

就是不想一行行的用连接字符串的模式处理，想用DOM的Node处理
up一下……

Answer 3

只有一行一行来，你还有要按一定格式的要求。
在 excel 里加个VBA，一劳永逸了。

Answer 4

http://topic.csdn.net/u/20090713/18/6e14bf28-1979-4ade-9c60-aaf09284553d.html
找到好贴，学习中……

Answer 5

谢谢猴哥，
不过，水晶报表我大概是学不了；我自己找了一些资料，关于XML介绍的，看完先……
等一下贴上我的资源链接

Answer 6

Option ExplicitSub Main()
    Dim xmlDoc As DOMDocument
    Dim xmlPI As IXMLDOMProcessingInstruction
    Dim xmlRoot As IXMLDOMElement
    Dim xmlVoucher As IXMLDOMElement
    Dim xmlVoucherHead As IXMLDOMElement
    Dim xmlVoucherBody As IXMLDOMElement
    Dim i As Long
    
    Set xmlDoc = New DOMDocument
    Set xmlPI = xmlDoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""gb2312""")
    xmlDoc.appendChild xmlPI
    
    Set xmlRoot = xmlDoc.createElement("interface")
    xmlDoc.appendChild xmlRoot
    
    For i = 1 To 2
        Set xmlVoucher = AddChild(xmlDoc, xmlRoot, "voucher")
        xmlVoucher.setAttribute "id", ""
        
        Set xmlVoucherHead = AddChild(xmlDoc, xmlVoucher, "voucher_head")
        AddTextChild xmlDoc, xmlVoucherHead, "Voucher_Id", i
        AddTextChild xmlDoc, xmlVoucherHead, "Oper", "Admin" & i
        
        Set xmlVoucherBody = AddChild(xmlDoc, xmlVoucher, "voucher_body")
        
        AddEntry xmlDoc, xmlVoucherBody, 1, "测试摘要", "540401" & i, IIf(i = 1, 1000, 900), 0, "02005", "02005001"
        AddEntry xmlDoc, xmlVoucherBody, 2, "测试摘要", "100101", 0, IIf(i = 1, 1000, 900)
        
    Next    xmlDoc.save "C:\temp\1.xml"
End SubFunction AddChild(ByVal xmlDoc As DOMDocument, _
                  ByVal xmlParent As IXMLDOMElement, _
                  ByVal tagName As String _
                 ) As IXMLDOMElement
    Dim xmlChild As IXMLDOMElement
    
    Set xmlChild = xmlDoc.createElement(tagName)
    xmlParent.appendChild xmlChild
    
    Set AddChild = xmlChild
End FunctionFunction AddTextChild(ByVal xmlDoc As DOMDocument, _
                      ByVal xmlParent As IXMLDOMElement, _
                      ByVal tagName As String, _
                      ByVal Text As String _
                     ) As IXMLDOMElement
    Dim xmlChild As IXMLDOMElement
    Dim xmlText  As IXMLDOMText
    
    Set xmlChild = xmlDoc.createElement(tagName)
    xmlParent.appendChild xmlChild
    xmlChild.Text = Text
    
    Set AddTextChild = xmlChild
End FunctionSub AddEntry(ByVal xmlDoc As DOMDocument, _
             ByVal xmlParent As IXMLDOMElement, _
             ByVal id As Long, _
             ByVal ZhaiYao As String, _
             ByVal acc_code As String, _
             ByVal jiefang As String, _
             ByVal daifang As String, _
             Optional ByVal department As String, _
             Optional ByVal project As String)
    Dim xmlEntry As IXMLDOMElement
    Dim xmlAccounting As IXMLDOMElement
    Dim xmlItem As IXMLDOMElement
    
    Set xmlEntry = AddChild(xmlDoc, xmlParent, "entry")
    AddTextChild xmlDoc, xmlEntry, "Entry_id", id
    AddTextChild xmlDoc, xmlEntry, "ZhaiYao", ZhaiYao
    AddTextChild xmlDoc, xmlEntry, "jiefang", jiefang
    AddTextChild xmlDoc, xmlEntry, "daifang", daifang
    If LenB(department) <> 0 Then
        Set xmlAccounting = AddChild(xmlDoc, xmlEntry, "auxiliary_accounting")
        
        Set xmlItem = AddTextChild(xmlDoc, xmlAccounting, "item", department)
        xmlItem.setAttribute "name", "部门"
        
        Set xmlItem = AddTextChild(xmlDoc, xmlAccounting, "item", project)
        xmlItem.setAttribute "name", "项目工程"
    End If
End Sub

Answer 7

非常感谢“VB老鸟”！
还给出了这么多的函数，都可以直接引用的。
如果要从EXCEL中引用？就是再引用一个EXCEL对象，进行单元格替换代码中的部分文字？Option Explicit
Sub Main()
    Dim xmlDoc As DOMDocument
    Dim xmlPI As IXMLDOMProcessingInstruction
    Dim xmlRoot As IXMLDOMElement
    Dim xmlVoucher As IXMLDOMElement
    Dim xmlVoucherHead As IXMLDOMElement
    Dim xmlVoucherBody As IXMLDOMElement
    Dim i As Long
    
    Set xmlDoc = New DOMDocument
    Set xmlPI = xmlDoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""gb2312""")
    xmlDoc.appendChild xmlPI
    
    Set xmlRoot = xmlDoc.createElement("interface")
    xmlDoc.appendChild xmlRoot
    
    For i = 1 To 2
        Set xmlVoucher = AddChild(xmlDoc, xmlRoot, "voucher")
        xmlVoucher.setAttribute "id", ""
        
        Set xmlVoucherHead = AddChild(xmlDoc, xmlVoucher, "voucher_head")
        AddTextChild xmlDoc, xmlVoucherHead, "Voucher_Id", i
        AddTextChild xmlDoc, xmlVoucherHead, "Oper", "Admin" & i
        
        Set xmlVoucherBody = AddChild(xmlDoc, xmlVoucher, "voucher_body")
        
        AddEntry xmlDoc, xmlVoucherBody, 1, "测试摘要", "540401" & i, IIf(i = 1, 1000, 900), 0, "02005", "02005001"
        AddEntry xmlDoc, xmlVoucherBody, 2, "测试摘要", "100101", 0, IIf(i = 1, 1000, 900)
        
    Next    xmlDoc.save "C:\temp\1.xml"
End SubFunction AddChild(ByVal xmlDoc As DOMDocument, _
                  ByVal xmlParent As IXMLDOMElement, _
                  ByVal tagName As String _
                 ) As IXMLDOMElement
    Dim xmlChild As IXMLDOMElement
    
    Set xmlChild = xmlDoc.createElement(tagName)
    xmlParent.appendChild xmlChild
    
    Set AddChild = xmlChild
End FunctionFunction AddTextChild(ByVal xmlDoc As DOMDocument, _
                      ByVal xmlParent As IXMLDOMElement, _
                      ByVal tagName As String, _
                      ByVal Text As String _
                     ) As IXMLDOMElement
    Dim xmlChild As IXMLDOMElement
    Dim xmlText  As IXMLDOMText
    
    Set xmlChild = xmlDoc.createElement(tagName)
    xmlParent.appendChild xmlChild
    xmlChild.Text = Text
    
    Set AddTextChild = xmlChild
End FunctionSub AddEntry(ByVal xmlDoc As DOMDocument, _
             ByVal xmlParent As IXMLDOMElement, _
             ByVal id As Long, _
             ByVal ZhaiYao As String, _
             ByVal acc_code As String, _
             ByVal jiefang As String, _
             ByVal daifang As String, _
             Optional ByVal department As String, _
             Optional ByVal project As String)
    Dim xmlEntry As IXMLDOMElement
    Dim xmlAccounting As IXMLDOMElement
    Dim xmlItem As IXMLDOMElement
    
    Set xmlEntry = AddChild(xmlDoc, xmlParent, "entry")
    AddTextChild xmlDoc, xmlEntry, "Entry_id", id
    AddTextChild xmlDoc, xmlEntry, "ZhaiYao", ZhaiYao
    AddTextChild xmlDoc, xmlEntry, "jiefang", jiefang
    AddTextChild xmlDoc, xmlEntry, "daifang", daifang
    If LenB(department) <> 0 Then
        Set xmlAccounting = AddChild(xmlDoc, xmlEntry, "auxiliary_accounting")
        
        Set xmlItem = AddTextChild(xmlDoc, xmlAccounting, "item", department)
        xmlItem.setAttribute "name", "部门"
        
        Set xmlItem = AddTextChild(xmlDoc, xmlAccounting, "item", project)
        xmlItem.setAttribute "name", "项目工程"
    End If
End Sub

Answer 8

有人关我进小黑屋吗？
我自己上传的资源“XPath介绍-图文版”怎么找不到链接呢？
再上传，总是提示“您已经上传过了”

Answer 9

http://www.w3school.com.cn/example/xdom_examples.asp
XML DOM 实例,挺好的。
也感谢大家，呵呵
结贴