SendUsingAccount SendAs 权限但未在索引中找到

Posted 2023-04-19

【中文标题】SendUsingAccount SendAs 权限但未在索引中找到

【英文标题】：SendUsingAccount SendAs permissions but not finding in index

【发布时间】：2018-12-14 19:15:32

【问题描述】：

我需要能够从不同的电子邮件地址从 VBA 发送电子邮件。我有权从该地址发送，并且可以从 Outlook 消息窗口手动选择它。但是，当我运行以下代码时，它没有索引。显示的只是我的电子邮件地址。

Sub Which_Account_Number()
'Don't forget to set a reference to Outlook in the VBA editor
    Dim OutApp As Object
    Dim I As Long

    Set OutApp = CreateObject("Outlook.Application")

    For I = 1 To OutApp.Session.Accounts.Count
        MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
    Next I
End Sub

有没有办法在通话中使用实际的电子邮件地址？这是我想要完成的测试代码：

Sub SendMessagesTest()

   Dim objOutlook As Object ' Outlook.Application
   Dim objOutlookMsg As Object ' Outlook.MailItem
   Dim objOutlookRecip As Object ' Outlook.Recipient

    ' Create the Outlook session.
   Set objOutlook = CreateObject("Outlook.Application")
   objOutlook.Session.Logon

   ' Create the message.
   Set objOutlookMsg = objOutlook.CreateItem(0)   '0 = olMailItem              

    With objOutlookMsg

         ' Set the Subject & Body of the message.
         .Subject = "Test Subject"
         .Body = "Test Body"
         '.BodyFormat = 3   '3 = olFormatRichText  (Late Binding)

        'Change Item(1)to another number to use another account
       Set .SendUsingAccount = "[e-mail]" 'objOutlook.Session.Accounts.Item(2)  ' (Late Binding)

       .Display

   End With

    Set objOutlook = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookRecip = Nothing
    Exit Sub

End Sub

当我运行它时，我收到错误“需要对象”。

我不能使用这种类型的代码，因为我没有用于电子邮件地址的索引号：

Set .SendUsingAccount = objOutlook.Session.Accounts.Item(1) 

编辑：这是我用来将约会项目添加到与我共享的另一个用户的日历中的代码。注意：我对尝试发送为的邮箱拥有发布编辑权限。

Sub CreateCalendarApptx()
    Dim objApp As Object
    Dim objNS As Object
    Dim objFolder As Object
    Dim objRecip As Object
    Dim objAppt As Object
    Dim objMsg As Object
    Const olMailItem = 0
    Const olFolderCalendar = 9
    Dim strName As String

    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.getNamespace("MAPI")
    Set objMsg = objApp.CreateItem(olMailItem)

   strName = "[e-mail]"
    'Select Calendar on which to place the appointment
    'The Calendar can either be set with the name of the calendar or the Folder ID
    If Left(strName, 3) = "ID:" Then
        'Strip out the ID: identifier and leave just the ID
        strName = Mid(strName, 5, Len(strName))
        Set objFolder = objNS.GetFolderFromID(strName)
    Else
        Set objRecip = objMsg.Recipients.Add(strName)
        objRecip.Resolve
        If objRecip.Resolved Then
            Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
        End If
    End If

    Set objAppt = objFolder.Items.Add
    objAppt.Subject = "Test"
    objAppt.Display

   Set objApp = Nothing
    Set objNS = Nothing
    Set objFolder = Nothing
    Set objMsg = Nothing
    Set objRecip = Nothing
    Set objAppt = Nothing

End Sub

编辑 2： 我之前添加了另一条评论，但董事会似乎不喜欢它，因为我附上了一张图片。结果是，当我从 Outlook 界面发送一封电子邮件，在 From: 字段中使用不同的名称时，它发送成功。但是，当我将鼠标悬停在它上面时，我看到“发件人：[e-mail] 使用帐户发送：[e-mail]”如果是这种情况，VBA 中的 SendUsingAccount 将是我的电子邮件地址，并且应该有另一个属性将是 From: 字段。

【问题讨论】：

转到文件选项卡，您将在顶部附近看到“添加帐户”按钮。如果你成功了，就会有第 2 项。

【参考方案1】：

改变你的陈述：

Set .SendUsingAccount = objOutlook.Session.Accounts.Item(1) 

到：

Set .SendUsingAccount = objOutlook.Session.Accounts.Item("[e-mail]") 

【参考方案2】：

我能够让 SendUsingAccount 工作 - 除了项目位于其他帐户的发件箱中并且从未发送过。

我终于通过创建一个邮件配置文件来实现它，该配置文件将我想要发送的帐户作为唯一帐户。然后我添加了我的邮件帐户，但将 SendUsingAccount 作为配置文件使用的默认帐户。这样它就可以继续工作了。

但这有点不方便，除非运行该软件的计算机不是我的主计算机，因此将默认配置文件设置为我以外的邮件帐户是可以忍受的。

【参考方案3】：

您是代表委托 Exchange 邮箱发送吗？设置MailItem.SentOnBehalfOfName 属性。

【讨论】：

感谢您的回复。我不想代表发送，我希望它看起来像来自其他用户的电子邮件。

您是否真的尝试过使用 SentOnBehalfOfName 属性？

是的。电子邮件已创建，但返回此错误：“无法发送此邮件。您无权代表指定用户发送邮件。”我认为错误是因为我没有权限“代表该用户发送”，只能“发送为”。

如果您有发送/接收权限，您可以创建一个以该邮箱为主要邮箱的配置文件。

我按照您的建议创建了另一个配置文件，并将配置文件添加到上面代码中的登录行，如下所示：objOutlook.Session.Logon "Other Profile", , True, True。它仍在发件人字段中使用我的电子邮件。你能告诉我我在哪里错过了船吗？

【参考方案4】：

Re：评论其他答案帖子。 “我可以通过 VBA 在其他人的日历上设置约会”是不寻常的。

如果你有这样的权限，对另一个邮箱的收件箱，你也许可以这样做。

Option Explicit

Sub SendMailFromNonDefaultAccount()

    ' The only way I know this works is to
    '  use the "Add Account" button to add a non-default account.
    ' Not "Account Settings" which adds a mailbox to the default Account.

    Dim myRecipient As recipient
    Dim nonDefaultInboxFolder As Folder
    Dim addMail As MailItem

    ' This is where your unusual permission, without adding an account, might yet kick in
    Set myRecipient = Session.CreateRecipient("non-default email address as a string inside quotes")

    Set nonDefaultInboxFolder = Session.GetSharedDefaultFolder(myRecipient, olFolderInbox)

    ' Add, not create, in non-default folder
    Set addMail = nonDefaultInboxFolder.Items.Add

    ' The non-default email address will be in the "From"
    addMail.Display

End Sub

将共享日历的代码应用于共享收件箱。

Option Explicit

Sub CreateCalendarAppt_and_mail()

    Dim objApp As Object
    Dim objNS As Object
    Dim objFolder As Object
    Dim objRecip As Object
    Dim objAppt As Object
    Dim objMsg As Object

    Dim objInboxShared As Object
    Dim objMsgShared As Object

    ' If there is no reference to the Outlook Object Library
    Const olFolderInbox = 6

    Const olMailItem = 0
    Const olFolderCalendar = 9

    Dim strName As String

    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")

    Set objMsg = objApp.CreateItem(olMailItem)

    strName = "[e-mail]"
    Debug.Print strName

    Set objRecip = objMsg.Recipients.Add(strName)
    objRecip.Resolve

    If objRecip.Resolved Then

        Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
        Set objAppt = objFolder.Items.Add
        objAppt.Subject = "Test"
        objAppt.Display

        ' Follows the format of the calendar code
        ' Looks the same as my original code
        Set objInboxShared = objNS.GetSharedDefaultFolder(objRecip, olFolderInbox)
        ' objInboxShared.Display
        Set objMsgShared = objInboxShared.Items.Add
        objMsgShared.Subject = "Test Message"
        objMsgShared.Display

    End If

    Set objApp = Nothing
    Set objNS = Nothing
    Set objFolder = Nothing
    Set objMsg = Nothing
    Set objRecip = Nothing
    Set objAppt = Nothing

    Set objInboxShared = Nothing
    Set objMsgShared = Nothing

End Sub

【讨论】：

我用我想用作我的 From: 地址的电子邮件地址替换了电子邮件地址，然后尝试了您的代码。我收到错误“尝试的操作失败。找不到对象。”此行引发错误： Set addMail = nonDefaultInboxFolder.Items.Add

紧跟在Set nonDefaultInboxFolder = Session.GetSharedDefaultFolder(myRecipient, olFolderInbox) 之后的Debug.Print nonDefaultInboxFolder 会得到什么？

我在添加该行时遇到了同样的错误，但现在它被抛出该行。我还在即时窗口中尝试了 ?nonDefaultInboxFolder 并得到了同样的错误。

看来你必须弄清楚如何使用添加帐户。

我不喜欢使用添加帐户选项。当我这样做时，它会向我显示他日历中的所有提醒，而我不需要或不想要这些。我可以从 Outlook 界面为我具有代理发送权限的帐户执行此操作。看起来我应该拥有与 VBA 相同的能力。

【参考方案5】：

我有两台机器遇到了同样的问题。

使用第一台计算机时，系统会提示用户在打开 Outlook 时选择配置文件。通过将控制面板/邮件配置文件设置为“始终使用此配置文件”，问题得到解决。

第二台机器有两个配置文件。即使选择了主要的“始终使用此配置文件”，它仍然存在同样的问题。通过删除第二个配置文件，问题就消失了。