用vb將word文檔生成xml文件并互相轉換

1. 建立一個新的vb工程

2. 引用 Microsoft XML,版本 2.0 或以上

3. 在窗體form1上建立按鈕 cmdCreateXML 和 cmdGetBinary

代碼：

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 Aclearcase/" target="_blank" >ccess 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

4. 建立word文檔DocInput.doc.


5. 保存文檔在工程目錄下

6. 運行程序點擊cmdCreateXML 按鈕.一個 XML 文件XmlOuput.xml 就建立了.
點擊 cmdGetBinary 按鈕就可以生成word文檔 DocOutput.doc.


按照上面的方法，同樣可以將任意的二進制數據存為xml，然后再重新生成二進制數據

可以用于web傳輸等等可以使用xmlhttp的地方

原文轉自：http://www.anti-gravitydesign.com