列出/获取 Outlook 中的所有 SentOnBehalfofName

Question

我有一个创建新电子邮件的宏，代表发送......但我不想明确使用硬编码的电子邮件地址，而是询问 Outlook 已经设置了哪些地址。

我正在考虑使用过滤器（例如 .... 以“@myonbehalfdomain.com”结尾）

所以在下面的示例中：Eonbehalf 应该获得第二个电子邮件地址，我可以在新电子邮件中使用下拉“发件人”字段看到该地址。

有道理吗？

Sub CreateNewMail()

    Dim olNS As Outlook.NameSpace

    Dim oMail As Outlook.MailItem

    Set olNS = Application.GetNamespace("MAPI")

    Set oMail = Application.CreateItem(olMailItem)

    strbody = "<BR><BR><BR>"

    SigString = Environ("appdata") & _

                "\Microsoft\Handtekeningen\custom.htm"


    If Dir(SigString) <> "" Then

        Signature = GetBoiler(SigString)

    Else

        Signature = ""

    End If


    On Error Resume Next

    Eonbehalf = getemailaddress(2)

        oMail.SentOnBehalfOfName = Eonbehalf

        oMail.Display

        oMail.HTMLBody = strbody & Signature

    Set oMail = Nothing

    Set olNS = Nothing


End Sub

Answer 1

根据我的经验，电子邮件可以通过两种方式在 Outlook 中用作“代表发送”：

• 作为附加/单独帐户
• 作为对共享文件夹/邮箱的访问，在这种情况下，它在帐户集合中不可见

对于第一种情况，尝试循环访问 Accounts 集合：

Sub getAccount()

Set oNS = Application.GetNamespace("MAPI")

    For Each oAccount In oNS.Accounts
    'your code goes here (read oAccount.DisplayName for example)
    Next oAccount

End Sub

在后一种情况下：

Sub getFolder()

Set oNS = Application.GetNamespace("MAPI")

    For Each oFolder In oNS.Folders
        'your code goes here (read oFolder.Name for example)
    Next oFolder

End Sub

******************************编辑****************** ************

尝试用fnGetSecondAdress("theEmailDomainYouReLookingFor")替换getemailaddress(2)

并将以下函数添加到您的代码中

Function fnGetSecondAdress(strDomain As String)

Dim strAddress As String


Set oNS = Application.GetNamespace("MAPI")

    For Each oFolder In oNS.Folders
                If InStr(1, oFolder.Name, strDomain, vbTextCompare) >= 1 And InStr(1, oFolder.Name, "Public Folders", vbTextCompare) = 0 Then
                    strAddress = oFolder.Name
                End If
    Next oFolder


fnGetSecondAdress = strAddress

End Function