Scan through email and change field names

问题

I currently have:

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

I tweaked your code slightly to keep the table in the new message created using the HTMLBody rather than just Body. This then keeps the tags in the new email, how would I go about changing the field names in the email now?

The format of the email is as follows (except it is in a table):

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

I need to change:

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:

Also if possible, am I able to add a border to the table using vba code?

回答1:

To change the fields you've identified, change this line (itmNew.HTMLBody = myMessage & vbCr & vbCr & itmOld.HTMLBody) by replacing it with the following lines (adding what I've left out for simplicity):

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

To add a border to your table, use this, changing the parameter as needed, and place it before the final line of the above block.

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

If you want just a border on the outside, then change to the following instead:

' 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>")

来源：https://stackoverflow.com/questions/15682405/scan-through-email-and-change-field-names

标签

html

vba

text

outlook

outlook-vba