Outlook收件人地址到字段

时间:2016-02-17 08:15:15

标签: vba email outlook outlook-vba

我正在创建自定义回复,因为帐户的Outlook发送已更改,并且某些字段会自动填充。

首先,我将解释它是如何工作的,我们会收到一封电子邮件。收到此电子邮件的电子邮件地址位于CC中。我在顶栏中创建了一个按钮。当我按下此按钮时,会打开一个新的电子邮件屏幕,其中包含一些已填写的信息以及我们需要填写的剩余信息。

最重要的是我有一切设置。但有一件事我无法开展工作。我希望将新电子邮件发送到原始的TO(收件人)地址。

现在我有了这段代码:

Sub ReplyUsingAccount()
Dim oAccount As Outlook.Account
Dim objItem As Outlook.MailItem
Dim oMail As Outlook.MailItem
Dim strAcc As String
Dim i As Long
Set objItem = ActiveExplorer.Selection.Item(1)
strAcc = "myemail@email.nl"
For Each oAccount In Application.Session.Accounts
    If oAccount.DisplayName = strAcc Then
        Set oMail = Application.CreateItem(olMailItem)
        With oMail
            .SendUsingAccount = oAccount
            .To = objItem.RecipientEmailAddress
            .Subject = "Aangaande uw bestelling bij "
                       .HTMLBody = "<br><br><br>" & _
                        "<hr width=""50%"" size=""2"" noshade />" & _
                        "<font color=""#6699ff"">" & _
                        objItem.HTMLBody & "</font>"
            .Display
        End With
    End If
Next oAccount
Set oAccount = Nothing
Set objItem = Nothing
Set oMail = Nothing
End Sub

.To = objItem.RecipientEmailAddress 无效。 任何人都有解决方案。

提前致谢。

3 个答案:

答案 0 :(得分:0)

我想它并没有返回SMTP电子邮件地址,因为您正在使用内部电子邮件地址返回.SenderEmailAddress属性(这意味着它将是EX类型地址,而不是SMTP)。

以下内容将返回内部和外部的SMTP地址。

Dim oOutlook As Outlook.Application
Dim senderAddress As String, recipEntryId As String, SmtpMailAddress As String
Dim oAddressEntry As Outlook.AddressEntry, oExchangeUser As Outlook.ExchangeUser
Dim oReply As Outlook.MailItem, oRecipient As Outlook.Recipient
Dim objItem As Outlook.MailItem

If objItem.SenderEmailType = "SMTP" Then

    senderAddress = objItem.SenderEmailAddress

Else

    Set oReply = objItem.Reply()
    Set oRecipient = oReply.Recipients.Item(1)

    recipEntryId = oRecipient.EntryID

    oReply.Close OlInspectorClose.olDiscard

    recipEntryId = oRecipient.EntryID

    Set oAddressEntry = oOutlook.GetAddressEntryFromID(recipEntryId)
    Set oExchangeUser = oAddressEntry.GetExchangeUser()

    senderAddress = oExchangeUser.PrimarySmtpAddress()

End If

SmtpMailAddress = senderAddress

然后,您可以使用getSmtpMailAddress变量作为.To电子邮件地址。

如果您使用的是Outlook 2010或更高版本,则可以使用.PropertyAccessor Property。我从来没有用过这个,但值得研究。

答案 1 :(得分:0)

我认为RecipientEmailAddress在VBA中无效。

尝试 SenderEmailAddress.

答案 2 :(得分:0)

要将所有收件人地址移至 .To 字段,示例就是。

Option Explicit
Sub Example()
    Dim olItem As Outlook.MailItem
    Dim olReply As MailItem ' Reply
    Dim Recipient As Outlook.Recipient
    Dim olRecip As String

    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox "No Item was Selected "
        Exit Sub
    End If

    For Each olItem In Application.ActiveExplorer.Selection
        Set olReply = olItem.Reply

        For Each Recipient In olItem.Recipients
            olRecip = Recipient.address & ";" & olRecip
        Next Recipient

        With olReply
            .To = olRecip ' all the Recipient
            .Subject = "Aangaande uw bestelling bij "
                       .HTMLBody = "<br><br><br>" & _
                        "<hr width=""50%"" size=""2"" noshade />" & _
                        "<font color=""#6699ff"">" & _
                        olReply.HTMLBody & "</font>"
            .Display
        End With

    Next

End Sub

添加发件人地址 .To = olRecip & ";" & olItem.SenderEmailAddress