扫描电子邮件并更改字段名称

时间:2013-03-28 12:56:09

标签: html vba text 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 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.HTMLBody = myMessage & vbCr & vbCr & itmOld.HTMLBody
    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

我稍微调整了你的代码,以便将表保存在使用HTMLBody而不仅仅是Body创建的新消息中。然后将标签保存在新电子邮件中,我现在如何更改电子邮件中的字段名称?

电子邮件的格式如下(除了在表格中):

Fullname:   Alex Carter
OPS_Access:     Yes
Email_Account_Required:     Yes
Office_Email_Required:  Yes
Website_Access_Required:    Yes
Web_Access_Level:   Staff
Forum_Access_Required:  Yes
Date_Account_Required:  03/08/2013
Requested_By:   Alex Carter
Requestee_Email:    alex.carter@driverhire.co.uk
Office_Requesting:  Swindon

我需要改变:

Fullname to New User's Name:
OPS_Access to dhOps Access Required:
Email_Account_Required - Email Account Required:
Office_Email_Required - Access to Office Email Required:
Website_Access_Required - Website Access Required:
Web_Access_Level - Level of web access:
Forum_Access_Required - Forum Access Required:
Date_Account_Required - Date Account Required:
Requested_By - Requested by:
Requestee_Email - Email of requesting user:
Office_Requesting - Requested office:

如果可能,我可以使用vba代码向表格添加边框吗?

1 个答案:

答案 0 :(得分:2)

要更改您已识别的字段,请更改此行(itmNew.HTMLBody = myMessage & vbCr & vbCr & itmOld.HTMLBody),方法是将其替换为以下行(添加为简单起见而遗漏的内容):

Dim tempBody As String

tempBody = itmOld.HTMLBody

'Change values to new desired output
tempBody = Replace(tempBody, "Fullname", "New User's Name:")
tempBody = Replace(tempBody , "OPS_Access", "dhOps Access Required:")
tempBody = Replace(tempBody , "Email_Account_Required", "Email Account Required:")
' ... continue as needed...

itmNew.HTMLBody = myMessage & vbCr & vbCr & tempBody

要为表格添加边框,请使用此项,根据需要更改参数,并将其放在上面块的最后一行之前。

' This adds a border to the original HTML table.
tempBody = Replace(tempBody, "<table>", "<table border = 1>")

如果您只想在外面使用边框,请改为:

' This adds another table (with border) to the HTML and puts the original table (no border) inside it.
tempBody = Replace(tempBody, "<table>", "<table border = 1><tr><td><table>") 
tempBody = Replace(tempBody, "</table>", "</table></td></tr></table>")