这里有一篇类似的,你看看对你有没有:
用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 StringPrivate Sub cmdCreateXML_Click()Dim oEle As IXMLDOMElement
Dim oRoot As IXMLDOMElement
Dim oNode As IXMLDOMNodeDOCINPATH = App.Path & "\DocInput.doc"
XMLOUTPATH = App.Path & "\XmlOuput.xml"Call ReleaseObjectsSet 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 oNodeSet oNode = oDoc.createElement("CreateDate")
oRoot.appendChild oNode
Set oEle = oNode' Use DataType so MSXML will validate the data type
oEle.dataType = "date"oEle.nodeTypedValue = NowSet 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 = &HFFCCCCSet 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 XMLOUTPATHMsgBox XMLOUTPATH & " is created for you."End SubFunction 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 iFileReadBinData = arrBytes
End FunctionPrivate Sub WriteBinData(ByVal strFileName As String)
Dim iFile As Integer
Dim arrBuffer() As Byte
Dim oNode As IXMLDOMNodeIf 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 diskiFile = FreeFile()
Open strFileName For Binary Access Write As iFile
Put iFile, , arrBuffer
Close iFileEnd IfEnd SubPrivate Sub cmdGetBinary_Click()DOCOUTPATH = App.Path & "\DocOutput.doc"Set oDoc = New DOMDocumentIf oDoc.Load(XMLOUTPATH) = True Then
' Save the Doc as another file
WriteBinData DOCOUTPATHMsgBox DOCOUTPATH & " is created for you."
Else
MsgBox oDoc.parseError.reason
End If
End SubPrivate Sub Form_Unload(Cancel As Integer)
ReleaseObjects
End SubPrivate Sub ReleaseObjects()
Set oDoc = Nothing
End Sub 4. 建立word文档DocInput.doc.
5. 保存文档在工程目录下6. 运行程序点击cmdCreateXML 按钮.一个 XML 文件XmlOuput.xml 就建立了.
点击 cmdGetBinary 按钮就可以生成word文档 DocOutput.doc.
按照上面的方法,同样可以将任意的二进制数据存为xml,然后再重新生成二进制数据可以用于web传输等等可以使用xmlhttp的地方

解决方案 »

  1.   

    很简单:
    Sub ConvertWordDoc()
        Static WordObj As Word.Application
        Set WordObj = CreateObject("Word.Application")
        WordObj.Documents.Open ("c:\my documents\test.htm")
        'Disable viewing the Word session
        'and its document
        WordObj.Visible = False
        WordObj.ActiveDocument.SaveAs "c:\my documents\test.doc"
        WordObj.Quit savechanges:=False
        Set WordObj = Nothing
    End Sub
      

  2.   

    关键的问题是:把HTM文件中的图片嵌入DOC文件中,也就是说把图片和DOC文件存为一个整体!