吉日愉快，解决问题后给大分！分不够还可以加哟

jacky_hou 2004-12-25 08:35:12
公司 税号 电话 联系人 地址
北京1公司 110001719612345 12345678 张飞 北京1路
北京2公司 110001245521222 23456781 刘1 北京2路
北京3公司 110001719612451 12345672 刘2 北京3路
北京4公司 110001719612654 12345673 刘3 北京4路
北京5公司 110001719612789 12345674 刘4 北京5路
北京6公司 110001719612321 12345675 刘5 北京6路

上面是一个ACCESS数据库中的一张表test,其值已经在上面显示出来，我想把这个表中的数据生成一个
XML文件,如下
<?xml version="1.0" encoding="GB2312"?>
<FileId fileid="9">
<ResultSet>
<row id="0">
<col name="KHMC">北京1公司</col>
<col name="BGDD">110001719612345</col>
<col name="TXDZ">12345678</col>
<col name="YZBM">张飞</col>
<col name="LXR">北京1路</col>
</row>
<row id="1">
<col name="KHMC">北京2公司</col>
<col name="BGDD">110001719612345</col>
<col name="TXDZ">1234567810</col>
<col name="YZBM">张飞</col>
<col name="LXR">北京2路</col>
</row>
<row id="2">
<col name="KHMC">北京3公司</col>
<col name="BGDD">110001719612345</col>
<col name="TXDZ">12345678</col>
<col name="YZBM">张飞</col>
<col name="LXR">北京3路</col>
</row>
<row id="3">
<col name="KHMC">北京4公司</col>
<col name="BGDD">110001719612345</col>
<col name="TXDZ">12345764</col>
<col name="YZBM">张飞</col>
<col name="LXR">北京4路</col>
</row>
<row id="4">
<col name="KHMC">北京5公司</col>
<col name="BGDD">110001719612345</col>
<col name="TXDZ">112451124</col>
<col name="YZBM">张飞</col>
<col name="LXR">北京5路路</col>
</row>
<row id="5">
<col name="KHMC">北京6公司</col>
<col name="BGDD">110001719612345</col>
<col name="TXDZ">12001241</col>
<col name="YZBM">张飞</col>
<col name="LXR">北京6路</col>
</row>
</ResultSet>
</FileId>

请众高手出招！
...全文
242 27 打赏 收藏 转发到动态 举报
写回复
用AI写文章
27 条回复
切换为时间正序
请发表友善的回复…
发表回复
道素 2004-12-28
  • 打赏
  • 举报
 回复
结果：
<FileId fileid="9">
<!-- 测试( writted by www.blanksoft.com)-->
<ResultSet>
<row Id="1">
<col name="KHMC">北京1公司</col>
<col name="BGDD">21</col>
</row>
<row Id="2">
<col name="KHMC">北京2公司</col>
<col name="BGDD">22</col>
</row>
<row Id="3">
<col name="KHMC">北京3公司</col>
<col name="BGDD">23</col>
</row>
<row Id="4">
<col name="KHMC">北京4公司</col>
<col name="BGDD">24</col>
</row>
<row Id="5">
<col name="KHMC">北京5公司</col>
<col name="BGDD">25</col>
</row>
</ResultSet>
</FileId>

我嫌麻烦所以只用了两个字段，其他同理，上边的代码生成缺少头和回车换行，可以看代码自己加
Records_node.appendChild _
xml_doc.createTextNode(vbCrLf)这就是加回车换行
也加了简单的注释，你可以看出可以任意加嵌套
道素 2004-12-28
  • 打赏
  • 举报
 回复
我简单写了一个例子：
Private Sub cmdGo_Click()
Dim xml_doc As New DOMDocument
Dim Records_node As IXMLDOMElement
Dim Records_node1 As IXMLDOMElement
Dim strSQL As String
Dim mConn As ADODB.Connection
Dim rst As ADODB.Recordset
Set mConn = New ADODB.Connection
mConn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=tempdb;Data Source=SHANG"
mConn.Open
strSQL = "select * from t1"
Set rst = mConn.Execute(strSQL)

Set Records_node = xml_doc.createElement("FileId")
Records_node.setAttribute "fileid", "9"
xml_doc.appendChild Records_node
Records_node.appendChild _
xml_doc.createTextNode(vbCrLf)

Records_node.appendChild xml_doc.createTextNode(" ")
Records_node.appendChild xml_doc.createComment(" " & _
"测试( writted by www.blanksoft.com)")
Records_node.appendChild _
xml_doc.createTextNode(vbCrLf)


Set Records_node1 = Records_node.appendChild(xml_doc.createElement("ResultSet"))



Do While (Not rst.EOF)
MakeRecord Records_node1, rst.Fields(0), rst.Fields(1), rst.Fields(2) ', rst.Fields(4), rst.Fields(5)
rst.MoveNext
Loop


' Write the document.
xml_doc.Save "c:\1.xml"

Debug.Print xml_doc.xml

MsgBox "Done"
End Sub

Private Sub MakeRecord(ByVal parent_node As _
IXMLDOMElement, ByVal strField1 As String, ByVal _
strField2 As String, ByVal strField3 As Integer)
Dim Record_node As IXMLDOMElement
Dim strField1_node As IXMLDOMElement
Dim strField2_node As IXMLDOMElement

Set Record_node = _
parent_node.ownerDocument.createElement("row")
parent_node.appendChild Record_node

Record_node.setAttribute "Id", Format$(strField1)

Set strField1_node = _
parent_node.ownerDocument.createElement("col")
Record_node.appendChild strField1_node
strField1_node.setAttribute "name", "KHMC"
strField1_node.appendChild _
parent_node.ownerDocument.createTextNode(strField2)

Set strField2_node = _
parent_node.ownerDocument.createElement("col")
Record_node.appendChild strField2_node
strField2_node.setAttribute "name", "BGDD"
strField2_node.appendChild _
parent_node.ownerDocument.createTextNode(strField3)
End Sub

Kivic 2004-12-28
  • 打赏
  • 举报
 回复
Set root = NodeFactory.createNode(NODE_ELEMENT, "FileId", "9")
xml.appendChild root
Set basenode = root
Set childnode = NodeFactory.createNode(NODE_ELEMENT, "ResultSet", vbNullString)
basenode.appendChild childnode
.......

jacky_hou 2004-12-28
  • 打赏
  • 举报
 回复
我的这个问题实际上难在节点的嵌套上面
<FileId fileid="9">在外面
里面是<ResultSet>
最里面是<row id="0">
如何搞,MICROSOFT没有告诉我们这个问题!
道素 2004-12-28
  • 打赏
  • 举报
 回复
为了程序更加简洁，通用，所以写了通用函数，格式化一个DOMDocument
对象：

Private Sub cmdGo_Click()
Dim xml_doc As New DOMDocument
Dim Records_node As IXMLDOMElement
Dim Records_node1 As IXMLDOMElement
Dim pi As IXMLDOMProcessingInstruction

Dim strSQL As String
Dim mConn As ADODB.Connection
Dim rst As ADODB.Recordset
Set mConn = New ADODB.Connection
mConn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=tempdb;Data Source=SHANG"
mConn.Open
strSQL = "select * from t1"
Set rst = mConn.Execute(strSQL)
Set pi = xml_doc.createProcessingInstruction("xml", "version=""1.0""")
xml_doc.insertBefore pi, root


'添加根
Set Records_node = xml_doc.createElement("FileId")
Records_node.setAttribute "fileid", "9"
xml_doc.appendChild Records_node
'Records_node.appendChild xml_doc.createTextNode(vbCrLf)
'添加注释
Records_node.appendChild xml_doc.createTextNode(" ")
Records_node.appendChild xml_doc.createComment(" 测试( writted by www.blanksoft.com)")
'Records_node.appendChild xml_doc.createTextNode(vbCrLf)

'再添加一级节点
'Records_node.appendChild xml_doc.createTextNode(Space$(4))


Set Records_node1 = Records_node.appendChild(xml_doc.createElement("ResultSet"))

' Records_node1.appendChild xml_doc.createTextNode(vbCrLf)

Do While (Not rst.EOF)
MakeRecord 8, Records_node1, rst.Fields(0), rst.Fields(1), rst.Fields(2), rst.Fields(3), rst.Fields(4), rst.Fields(5)
'Records_node1.appendChild xml_doc.createTextNode(vbCrLf)

rst.MoveNext
Loop


' Write the document.
FormatXmlDocument xml_doc
xml_doc.Save "c:\1.xml"

Debug.Print xml_doc.xml

MsgBox "Done"
End Sub

Private Sub MakeRecord(ByVal indent As Integer, _
ByVal parent_node As IXMLDOMElement, _
ByVal strField0 As String, _
ByVal strField1 As String, _
ByVal strField2 As String, _
ByVal strField3 As String, _
ByVal strField4 As String, _
ByVal strField5 As String)
Dim Record_node As IXMLDOMElement

'parent_node.appendChild parent_node.ownerDocument.createTextNode(Space$(indent))

Set Record_node = parent_node.ownerDocument.createElement("row")
parent_node.appendChild Record_node

Record_node.setAttribute "Id", Format$(strField0)
'Record_node.appendChild parent_node.ownerDocument.createTextNode(vbCrLf)


CreateNode 12, Record_node, "col", "KHMC", strField1
CreateNode 12, Record_node, "col", "BGDD", strField2
CreateNode 12, Record_node, "col", "TXDZ", strField3
CreateNode 12, Record_node, "col", "YZBM", strField4
CreateNode 12, Record_node, "col", "LXR", strField5


End Sub



Private Sub CreateNode(ByVal indent As Integer, _
ByVal parent As IXMLDOMElement, _
ByVal node_name As String, _
ByVal node_value As String, _
ByVal node_Text As String)
Dim new_node As IXMLDOMElement

' 缩进.
'parent.appendChild parent.ownerDocument.createTextNode(Space$(indent))

' 创建一个新节点.
Set new_node = parent.ownerDocument.createElement(node_name)
new_node.setAttribute "name", node_value

' 设置节点文本.
new_node.Text = node_Text

' 添加到父节点.
parent.appendChild new_node

' 换行.
'parent.appendChild parent.ownerDocument.createTextNode(vbCrLf)
End Sub

Private Sub FormatXmlDocument(ByVal xml_doc As DOMDocument)
FormatXmlNode xml_doc.documentElement, 0
End Sub
Private Sub FormatXmlNode(ByVal node As IXMLDOMNode, ByVal indent As Integer)
Dim child As IXMLDOMNode
Dim text_only As Boolean

If TypeOf node Is IXMLDOMText Then Exit Sub

text_only = True
If node.hasChildNodes Then
For Each child In node.childNodes
If Not (TypeOf child Is IXMLDOMText) Then
text_only = False
Exit For
End If
Next child
End If

' Process child nodes.
If node.hasChildNodes Then
' Add a carriage return before the children.
If Not text_only Then
node.insertBefore _
node.ownerDocument.createTextNode(vbCrLf), _
node.firstChild
End If

' Format the children.
For Each child In node.childNodes
FormatXmlNode child, indent + 2
Next child
End If

' Format this element.
If indent > 0 Then
' Indent before this element.
node.parentNode.insertBefore _
node.ownerDocument.createTextNode(Space$(indent)), _
node

' Indent after the last child node.
If Not text_only Then _
node.appendChild _
node.ownerDocument.createTextNode(Space$(indent))

' Add a carriage return after this node.
If node.nextSibling Is Nothing Then
node.parentNode.appendChild _
node.ownerDocument.createTextNode(vbCrLf)
Else
node.parentNode.insertBefore _
node.ownerDocument.createTextNode(vbCrLf), _
node.nextSibling
End If
End If
End Sub

我觉得现在的代码已经能满足你的要求了
道素 2004-12-28
  • 打赏
  • 举报
 回复
我重新修改了一下，增加换行和缩进，但是效果不好

Private Sub cmdGo_Click()
Dim xml_doc As New DOMDocument
Dim Records_node As IXMLDOMElement
Dim Records_node1 As IXMLDOMElement
Dim pi As IXMLDOMProcessingInstruction

Dim strSQL As String
Dim mConn As ADODB.Connection
Dim rst As ADODB.Recordset
Set mConn = New ADODB.Connection
mConn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=tempdb;Data Source=SHANG"
mConn.Open
strSQL = "select * from t1"
Set rst = mConn.Execute(strSQL)
Set pi = xml_doc.createProcessingInstruction("xml", "version=""1.0""")
xml_doc.insertBefore pi, root


'添加根
Set Records_node = xml_doc.createElement("FileId")
Records_node.setAttribute "fileid", "9"
xml_doc.appendChild Records_node
Records_node.appendChild xml_doc.createTextNode(vbCrLf)
'添加注释
Records_node.appendChild xml_doc.createTextNode(" ")
Records_node.appendChild xml_doc.createComment(" 测试( writted by www.blanksoft.com)")
Records_node.appendChild xml_doc.createTextNode(vbCrLf)

'再添加一级节点
Records_node.appendChild xml_doc.createTextNode(Space$(4))


Set Records_node1 = Records_node.appendChild(xml_doc.createElement("ResultSet"))

Records_node1.appendChild xml_doc.createTextNode(vbCrLf)

Do While (Not rst.EOF)
MakeRecord 8, Records_node1, rst.Fields(0), rst.Fields(1), rst.Fields(2), rst.Fields(3), rst.Fields(4), rst.Fields(5)
Records_node1.appendChild xml_doc.createTextNode(vbCrLf)

rst.MoveNext
Loop


' Write the document.
xml_doc.Save "c:\1.xml"

Debug.Print xml_doc.xml

MsgBox "Done"
End Sub

Private Sub MakeRecord(ByVal indent As Integer, _
ByVal parent_node As IXMLDOMElement, _
ByVal strField0 As String, _
ByVal strField1 As String, _
ByVal strField2 As String, _
ByVal strField3 As String, _
ByVal strField4 As String, _
ByVal strField5 As String)
Dim Record_node As IXMLDOMElement

parent_node.appendChild parent_node.ownerDocument.createTextNode(Space$(indent))

Set Record_node = parent_node.ownerDocument.createElement("row")
parent_node.appendChild Record_node

Record_node.setAttribute "Id", Format$(strField0)
Record_node.appendChild parent_node.ownerDocument.createTextNode(vbCrLf)


CreateNode 12, Record_node, "col", "KHMC", strField1
CreateNode 12, Record_node, "col", "BGDD", strField2
CreateNode 12, Record_node, "col", "TXDZ", strField3
CreateNode 12, Record_node, "col", "YZBM", strField4
CreateNode 12, Record_node, "col", "LXR", strField5


End Sub



Private Sub CreateNode(ByVal indent As Integer, _
ByVal parent As IXMLDOMElement, _
ByVal node_name As String, _
ByVal node_value As String, _
ByVal node_Text As String)
Dim new_node As IXMLDOMElement

' 缩进.
parent.appendChild parent.ownerDocument.createTextNode(Space$(indent))

' 创建一个新节点.
Set new_node = parent.ownerDocument.createElement(node_name)
new_node.setAttribute "name", node_value

' 设置节点文本.
new_node.Text = node_Text

' 添加到父节点.
parent.appendChild new_node

' 换行.
parent.appendChild parent.ownerDocument.createTextNode(vbCrLf)
End Sub
roger_xiong 2004-12-27
  • 打赏
  • 举报
 回复
有代码拿出来大家学习一下
jacky_hou 2004-12-27
  • 打赏
  • 举报
 回复
你这篇文章其实我看过，但是这篇文章没有讲三级以上的节点是如何设置的，而我的难点其实也是在这里,请再看看我的这个例子
<?xml version="1.0" encoding="GB2312"?>
<FileId fileid="9">
<ResultSet>
<row id="0">
<col name="KHMC">北京1公司</col>
<col name="BGDD">110001719612345</col>
<col name="TXDZ">12345678</col>
<col name="YZBM">张飞</col>
<col name="LXR">北京1路</col>
</row>
</ResultSet>
</FileId>


jacky_hou 2004-12-27
  • 打赏
  • 举报
 回复
大家一起努力！
Fashionxu 2004-12-27
  • 打赏
  • 举报
 回复
from msdn：

1、Create a new Visual Basic Standard EXE Project and save it.


2、Select Microsoft XML, Version 2.0 or later, in your project reference.


3、Create a button called cmdCreateXML and another one called cmdGetBinary on form1.


4、Give these buttons descriptive captions.


5、Paste the following code in the code module behind form1.



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' How to create XML with binary data
'
' General program flows:
'
' Build builds a small XML file from a MS Doc file
' Write saves XML tree to a file
' Write the MS Doc file as another file
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit
Dim oDoc As DOMDocument
Dim DOCINPATH As String
Dim XMLOUTPATH As String
Dim DOCOUTPATH As String

Private Sub cmdCreateXML_Click()

Dim oEle As IXMLDOMElement
Dim oRoot As IXMLDOMElement
Dim oNode As IXMLDOMNode

DOCINPATH = App.Path & "\DocInput.doc"
XMLOUTPATH = App.Path & "\XmlOuput.xml"

Call ReleaseObjects

Set oDoc = New DOMDocument
oDoc.resolveExternals = True

' Create processing instruction and document root
Set oNode = oDoc.createProcessingInstruction("xml", "version='1.0'")
Set oNode = oDoc.insertBefore(oNode, oDoc.childNodes.Item(0))

' Create document root
Set oRoot = oDoc.createElement("Root")
Set oDoc.documentElement = oRoot
oRoot.setAttribute "xmlns:dt", "urn:schemas-microsoft-com:datatypes"

' Add a few simple nodes with different datatypes
Set oNode = oDoc.createElement("Document")
oNode.Text = "Demo"
oRoot.appendChild oNode

Set oNode = oDoc.createElement("CreateDate")
oRoot.appendChild oNode
Set oEle = oNode

' Use DataType so MSXML will validate the data type
oEle.dataType = "date"

oEle.nodeTypedValue = Now

Set oNode = oDoc.createElement("bgColor")
oRoot.appendChild oNode
Set oEle = oNode

' Use DataType so MSXML will validate the data type
oEle.dataType = "bin.hex"

oEle.Text = &HFFCCCC

Set oNode = oDoc.createElement("Data")
oRoot.appendChild oNode
Set oEle = oNode

' Use DataType so MSXML will validate the data type
oEle.dataType = "bin.base64"

' Read in the data
oEle.nodeTypedValue = ReadBinData(DOCINPATH)

' Save xml file
oDoc.save XMLOUTPATH

MsgBox XMLOUTPATH & " is created for you."

End Sub

Function ReadBinData(ByVal strFileName As String) As Variant
Dim lLen As Long
Dim iFile As Integer
Dim arrBytes() As Byte
Dim lCount As Long
Dim strOut As String

'Read from disk
iFile = FreeFile()
Open strFileName For Binary Access Read As iFile
lLen = FileLen(strFileName)
ReDim arrBytes(lLen - 1)
Get iFile, , arrBytes
Close iFile

ReadBinData = arrBytes
End Function

Private Sub WriteBinData(ByVal strFileName As String)
Dim iFile As Integer
Dim arrBuffer() As Byte
Dim oNode As IXMLDOMNode

If Not (oDoc Is Nothing) Then

' Get the data
Set oNode = oDoc.documentElement.selectSingleNode("/Root/Data")

' Make sure you use a byte array instead of variant
arrBuffer = oNode.nodeTypedValue

' Write to disk

iFile = FreeFile()
Open strFileName For Binary Access Write As iFile
Put iFile, , arrBuffer
Close iFile

End If

End Sub

Private Sub cmdGetBinary_Click()

DOCOUTPATH = App.Path & "\DocOutput.doc"

Set oDoc = New DOMDocument

If oDoc.Load(XMLOUTPATH) = True Then
' Save the Doc as another file
WriteBinData DOCOUTPATH

MsgBox DOCOUTPATH & " is created for you."
Else
MsgBox oDoc.parseError.reason
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
ReleaseObjects
End Sub

Private Sub ReleaseObjects()
Set oDoc = Nothing
End Sub

1、Create a Microsoft Word document with some arbitrary content and name it DocInput.doc.


2、Save this Word file in the same folder as your project.


3、Run the project and click the cmdCreateXML button. An XML file named XmlOuput.xml is created.


4、Click the cmdGetBinary button and a Word file called DocOutput.doc is created.

供参考。
jacky_hou 2004-12-27
  • 打赏
  • 举报
 回复
我就不信没有人不知道！
xingnup 2004-12-27
  • 打赏
  • 举报
 回复
关注ing....!
jacky_hou 2004-12-27
  • 打赏
  • 举报
 回复
谢谢大家捧场 ！
cindytsai 2004-12-26
  • 打赏
  • 举报
 回复
先研究一下。
lazygod 2004-12-26
  • 打赏
  • 举报
 回复
有谁本着大公无私的精神给写个xml的Module？
painus 2004-12-26
  • 打赏
  • 举报
 回复
第一次见到XML的时候也想通过引用XML对象的方法来生成XML文件，但是后来发现很麻烦，而且网上的文章都是很简单的，我思考了好几天，没有办法的情况下选择了生成文本文件的方法。你自己参考吧！
还有呀，如果你用VB.net 的话，就简单多了！
flyingZFX 2004-12-26
  • 打赏
  • 举报
 回复
晕。
aohan 2004-12-26
  • 打赏
  • 举报
 回复
up
newsuperstar 2004-12-26
  • 打赏
  • 举报
 回复
ding
mumuyh 2004-12-26
  • 打赏
  • 举报
 回复
up!
加载更多回复（7）
民事吉日查询程序
民事吉日查询程序
[精品]最新吉日嘎拉通用权限管理系统源码 (C#)
[精品]最新吉日嘎拉通用权限管理系统源码 (C#) 吉日嘎拉 走火入魔通用权限设计源码,要学习的赶紧下载了!
吉日权限系统4.2完整源码.rar
最新吉日嘎拉 C#.NET 通用权限管理系统V4.2完整源码+数据库，仅供学习研究使用。
吉日权限系统4.2源码
吉日权限系统4.2源码
民事吉日查询程序V1.6破解版
民事吉日查询程序V1.6破解版 查询开业乔迁等吉日。
VB基础类

7,763

社区成员

197,605

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章