Сканирование по электронной почте и изменение имен полей

Question

В настоящее время у меня есть:

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:    [e-mail]
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?

Answer 1

Чтобы изменить поля, которые вы определили, измените эту строку (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>")