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.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

Body だけでなく、HTMLBody を使用して作成された新しいメッセージにテーブルを保持するように、コードを少し調整しました。これにより、新しいメールにタグが保持されます。メールのフィールド名を変更するにはどうすればよいですか?

電子メールの形式は次のとおりです (ただし、表になっています)。

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 コードを使用してテーブルに境界線を追加できますか?

4

1 に答える 1

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

table にボーダーを追加するには、これを使用し、必要に応じてパラメーターを変更して、上記のブロックの最終行の前に配置します。

' 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>")
于 2013-03-28T13:28:10.787 に答える