vba脚本解析html&创建xml

时间:2011-02-03 10:34:44

标签: html xml vba outlook

我正在尝试为outlook创建vba脚本,该脚本将解析消息(作为html表接收),并根据表中某些值的值创建一个xml文件。

请你指点我应该从哪里开始?
您也可以建议或向我推荐有关这些问题的资源/教程吗?

请考虑我没有vba经验,只有一些基本的C#

由于 TC

2 个答案:

答案 0 :(得分:0)

考虑到格式良好的HTML本质上 XML,我会尝试查看有关解析XML的一些问题,例如this

您只需查看table tr,然后查看td的内容...

答案 1 :(得分:0)

'*****************************************************************
'This is how the main structure of the XMl file is created in VBA
'Use this as guidance to create new XML files.
'*****************************************************************

Sub CreateXML()

Dim objDom As DOMDocument
Dim objRootElem As IXMLDOMElement
Dim objSubRootElem As IXMLDOMElement
Dim objMemberElem As IXMLDOMElement
Dim objSubMemberElem As IXMLDOMElement
Dim objMemberRel As IXMLDOMAttribute
Dim objMemberName As IXMLDOMElement

Set objDom = New DOMDocument    

' Creates root element
'Set objRootElem = objDom.createElement("r1")
'objDom.appendChild objRootElem

' Creates sub root element
'Set objSubRootElem = objDom.createElement("r2")
'objRootElem.appendChild objSubRootElem

' Creates Error Date & Time element
'Set objMemberElem = objDom.createElement("r3")
'objSubRootElem.appendChild objMemberElem

' Create element under Member element, and
' gives value "some guy"
'Set objMemberName = objDom.createElement("r3_Tag")
'objMemberElem.appendChild objMemberName
'objMemberName.Text = "value"

' Creates User Name element
'Set objMemberElem = objDom.createElement("r2_tag")
'objSubRootElem.appendChild objMemberElem
'objMemberElem.Text = "value"

' Creates Error Date & Time element
'Set objMemberElem = objDom.createElement("r3")
'objSubRootElem.appendChild objMemberElem

' Create element under Member element, and
' gives value "some guy"
'Set objMemberName = objDom.createElement("r3_Tag")
'objMemberElem.appendChild objMemberName
'objMemberName.Text = "value"

' Creates User Name element
'Set objMemberElem = objDom.createElement("r2_tag")
'objSubRootElem.appendChild objMemberElem
'objMemberElem.Text = "value"

'为了使这个对人类更具可读性,我们需要添加格式,缩进并添加 在孩子面前回来。然后递归 格式化压痕增加的​​孩子。

Sub FormatXmlNode(ByVal node As IXMLDOMNode, ByVal indent As Integer)
    Dim child As IXMLDOMNode
    Dim text_only As Boolean

    ' Do nothing if this is a text node.
    If TypeOf node Is IXMLDOMText Then Exit Sub

    ' See if this node contains only text.
    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(Chr(10)), 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(Chr(10))
        Else
            node.ParentNode.InsertBefore node.OwnerDocument.createTextNode(Chr(10)), node.NextSibling
        End If
    End If
End Sub

'将XML数据保存到磁盘。

On Error Resume Next
MkDir ("C:\Users\" & Environ$("Username") & _
"\Desktop\FXML_FILES") 'Creates folder on desktop, ignores error if it already exists
On Error GoTo 0

objDom.Save ("C:\Users\" & Environ$("Username") & _
"\Desktop\XML_FILES\" & "filename.xml")