SendUsingAccount разрешения SendAs, но не найдены в индексе - PullRequest
0 голосов
/ 14 декабря 2018

Мне нужно иметь возможность отправить электронное письмо от 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 = "TestUser@test.com" '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 = "OtherUser@Test.com"
    '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: OtherUser@test.com Отправить с использованием учетной записи: Me@test.com». Если это так, SendUsingAccount в VBA будет моим адресом электронной почты, и должно быть другое свойство, котороебудет поле From :.

Ответы [ 2 ]

0 голосов
/ 18 декабря 2018

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 = "OtherUser@Test.com"
    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 голосов
/ 14 декабря 2018

Отправляете ли вы от имени делегата почтовый ящик Exchange?Установите свойство MailItem.SentOnBehalfOfName.

...