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

问题描述 投票：0回答：6

我需要能够从不同的电子邮件地址通过 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 = "[email protected]" '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 = "[email protected]"
    '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 界面发送“发件人：”字段中具有不同名称的电子邮件时，它发送成功。但是，当我将鼠标悬停在它上面时，我会看到“发件人：[电子邮件受保护]使用帐户发送：[电子邮件受保护]”如果是这种情况，VBA 中的 SendUsingAccount 将是我的电子邮件地址，并且应该有另一个属性将是 From: 字段。

vba ms-access outlook
6个回答
1
投票

将您的陈述更改为：

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

至：

Set .SendUsingAccount = objOutlook.Session.Accounts.Item("[email protected]")
1
投票

我能够让 SendUsingAccount 正常工作 - 只不过项目位于其他帐户的发件箱中并且从未发送出去。

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

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

0
投票

您是否代表代理 Exchange 邮箱发送？设置 

MailItem.SentOnBehalfOfName
属性。

0
投票

回复：评论其他答案帖子。这样做“我可以通过 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 = "[email protected]"
    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
0
投票

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

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

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

0
投票

您是否找到过无法获取其他帐户索引的解决方案？已经有一段时间了，你还记得吗

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.