传入邮件的Outlook VBA脚本

时间:2013-03-27 17:20:04

标签: vba outlook outlook-vba

我尝试制作一个脚本来接收电子邮件,重新格式化然后转发到正文中的电子邮件但我无法弄清楚如何阅读电子邮件正文。我目前有:

Sub Confirmation()
myMessage = "You recently made a request on the IT website, the details of your
request can be seen below:" & vbCr & vbCr & "Thank you, " & vbCr & "IT Support"

Dim itmOld As MailItem, itmNew As MailItem

Set itmOld = ActiveInspector.CurrentItem
Set itmNew = itmOld.Forward

itmNew.Body = myMessage & vbCr & vbCr & itmOld.Body
itmNew.Subject = "IT Web Request Confirmation"
itmNew.Display

Set itmOld = Nothing
Set itmNew = Nothing
End Sub

这将打开电子邮件,为其添加一些文本并将其转发。

我希望脚本能够打开电子邮件,从正文中读取电子邮件地址,将其用作to字段,并将现有电子邮件重新格式化为更好的格式。 这是电子邮件中的HTML:

<html><body><br /><br /><table><tr><td><b>Fullname: </b></td><td>Alex Carter</td></tr><tr><td><b>OPS_Access: </b></td><td>Yes</td></tr><tr><td><b>Email_Account_Required: </b></td><td>Yes</td></tr><tr><td><b>Office_Email_Required: </b></td><td>Yes</td></tr><tr><td><b>Website_Access_Required: </b></td><td>Yes</td></tr><tr><td><b>Web_Access_Level: </b></td><td>Staff</td></tr><tr><td><b>Forum_Access_Required: </b></td><td>Yes</td></tr><tr><td><b>Date_Account_Required: </b></td><td>03/08/2013</td></tr><tr><td><b>Requested_By: </b></td><td>Alex Carter</td></tr><tr><td><b>Requestee_Email: </b></td><td>alex.carter@cars.co.uk</td></tr><tr><td><b>Office_Requesting: </b></td><td>Swindon</td></tr></table></body></html>

这表明进入to字段的电子邮件位于表格的第10行,但我不太确定如何从正文中选择此内容? 我如何阅读正文,重新格式化,然后选择被请求者的电子邮件并将其作为字段使用?

提前致谢!

1 个答案:

答案 0 :(得分:0)

这应该可以帮助您开始使用(修改代码),但是您必须更具体地了解您希望看到的格式改进...:

Sub Confirmation()
    myMessage = "You recently made a request on the IT website, the details of your request can be seen below:" & vbCr & vbCr & "Thank you, " & vbCr & "IT Support"
    Dim sAddress As String ' Well need this to store the address
    Dim itmOld As MailItem, itmNew As MailItem

    Set itmOld = ActiveInspector.CurrentItem
    Set itmNew = itmOld.Forward

    sAddress = GetAddressFromMessage(itmOld) ' This is our new function
    If Len(sAddress) > 0 Then
        itmNew.To = sAddress ' If our new function found a value apply it to the To: field.
        '!!! This should be checked as a valid address before continuing !!!
    End If

    itmNew.Body = myMessage & vbCr & vbCr & itmOld.Body
    itmNew.Subject = "IT Web Request Confirmation"
    itmNew.Display

    Set itmOld = Nothing
    Set itmNew = Nothing
End Sub

Private Function GetAddressFromMessage(msg As MailItem) As String
    ' Grabs the email from the standard HTML form described in the SO question.
    Dim lStart As Long
    Dim lStop As Long
    Dim sItemBody As String
    Const sSearchStart As String = "Requestee_Email: </b></td><td>" ' We will look for these tags to determine where the address can be found.
    Const sSearchStop As String = "</td>"

    sItemBody = msg.HTMLBody ' Read the body of the message as HTML to retain TAG info.

    lStart = InStr(sItemBody, sSearchStart) + Len(sSearchStart)
    If lStart > 0 Then ' Make sure we found the first TAG.
        lStop = InStr(lStart, sItemBody, sSearchStop)
    End If

    GetAddressFromMessage = vbNullString

    If lStop > 0 And lStart > 0 Then ' Make sure we really did find a valid field.
        GetAddressFromMessage = Mid(sItemBody, lStart, lStop - lStart)
    End If

End Function