Question

我需要能够通过其他电子邮件地址从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

当我运行它时，出现错误“ Object Required”。

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

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界面以“发件人：”字段中的其他名称发送电子邮件时，它发送成功。但是，当我将鼠标悬停在它上面时，会看到“发件人：OtherUser@test.com使用帐户发送：Me@test.com”。如果是这种情况，则VBA中的SendUsingAccount将是我的电子邮件地址，并且应该有另一个属性将是“发件人：”字段。

Answer 1

您是否代表代表Exchange邮箱发送邮件？设置MailItem.SentOnBehalfOfName属性。

Answer 2

回复：评论其他答案。 “我可以通过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

Answer 3

更改您的陈述：

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

收件人：

Set .SendUsingAccount = objOutlook.Session.Accounts.Item("Testuser@test.com")

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

3 个答案: