Question

首先我通过Outlook创建电子邮件：

Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.

Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Set olApp = Outlook.Application
'Create e-mail item
Set objMail = olApp.CreateItem(olMailItem)

Dim sHTML_Open              As String
Dim sHTML_Introduction      As String
Dim sHTML_Goodbye           As String
Dim sHTML_Close             As String
Dim sHTML_Process_Date      As String
Dim sHTML_Processor         As String
Dim sHTML_Issuer            As String
Dim sHTML_Details           As String

Dim sHTML_Body              As String

sHTML_Open = "<HTML><BODY>"
sHTML_Introduction = "Hi team,<BR/><BR/>" & _
                        "Data is ready to process. Please find details as below.<BR/>"
sHTML_Process_Date = "<P ID='PROCESSDATE'>28 February 2013</P>"
sHTML_Processor = "<P ID='PROCESSOR'>AKSHAY</ID></P>"
sHTML_Issuer = "<P ID='ISSUER'>DATAGROUP.COM</ID></P>"
sHTML_Details = "<P ID='DETAILS'>" & _
                    "<UL>" & _
                        "<LI>Fimta23456 09:00:00 flor345</LI>" & _
                        "<LI>Fimta23456 09:00:00 flor345</LI>" & _
                    "</UL>" & _
                "</P><BR/>"
sHTML_Goodbye = "Thanks"
sHTML_Close = "</BODY></HTML>"

sHTML_Body = sHTML_Open & sHTML_Introduction & sHTML_Process_Date & sHTML_Processor & sHTML_Issuer & _
          sHTML_Details & sHTML_Goodbye & sHTML_Close

With objMail
   'Set body format to HTML
   .BodyFormat = olFormatHTML
   .To = "Kim Gysen"
   .Subject = "data remit file"
   .HTMLBody = sHTML_Body
   .Display
End With
End Sub

通过代码，我想根据ID检索值。这对我来说似乎是最干净的方式，我不像“分裂”方法那样特别，因为它是一种硬编码;不是很有活力，有点不可靠。

不幸的是，当我检索HTML正文时，我无法检索原始HTML，因为它被Outlook扭曲了：

Sub Get_OL()

Dim oFolder                 As MAPIFolder
Dim oItem                   As Variant

Dim sHTML_Body              As String
Dim sHTML_Process_Date      As String
Dim sHTML_Processor         As String
Dim sHTML_Issuer            As String
Dim sHTML_Details           As String

Dim oExcel              As Object
Dim oBook               As Workbook

Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add


'Access the outlook inbox folder

Set oFolder = GetNamespace("MAPI").PickFolder

'On error resume next usually not to use, but feteching emails may give unexpected errors
On Error Resume Next
For Each oItem In oFolder.Items
    If TypeOf oItem Is Outlook.MailItem Then
        If oItem.Subject Like "*data remit file*" Then
            'Turn off on error resume next asap
            On Error GoTo 0
            sHTML_Body = oItem.HTMLBody
            Debug.Print sHTML_Body

            Exit For
        End If
    End If
Next oItem

End Sub

在debug.print上，这是我得到的（只放置格式的最后一行）：

</o:shapelayout></xml><![endif]--></head><body lang=EN-GB link=blue vlink=purple><div class=WordSection1><p class=MsoNormal>Hi team,<br><br>Data is ready to process. Please find details as below.<br><br><o:p></o:p></p><p>28 February 2013<o:p></o:p></p><p id=PROCESSOR>AKSHAY<o:p></o:p></p><p id=ISSUER>DATAGROUP.COM<o:p></o:p></p><ul type=disc><li class=MsoNormal style='mso-margin-top-alt:auto;mso-margin-bottom-alt:auto;mso-list:l0 level1 lfo1'>Fimta23456 09:00:00 flor345<o:p></o:p></li><li class=MsoNormal style='mso-margin-top-alt:auto;mso-margin-bottom-alt:auto;mso-list:l0 level1 lfo1'>Fimta23456 09:00:00 flor345<o:p></o:p></li></ul><p class=MsoNormal><br>Thanks<o:p></o:p></p></div></body></html>

我想检索我放在HTMLBody中的原始HTML。

Answer 1

2种方式：

1）解析文本 - 要做的几件事（不推荐：硬编码）

您需要的只是parse text，但MSDN会使用 InStr 功能显示如何执行此操作。我强烈建议使用RegEx来解析html文本。注意：需要参考 MS VBScript正则表达式x.x 。

Simple Regular Expression Tutorial for Excel VBA

2）使用UserProperites的MailItem对象（推荐）

如果MailItem不包含您的属性（y），则无需执行任何操作;）

How to: Add custom property

VBA从Outlook邮件中检索HTMLBody

1 个答案: