vba MS Access / Outlook 2010 - 如何选择从哪个帐户发送电子邮件？

MS Access / Outlook 2010 - how to choose which account to send email from?

提问by John Smith

I am trying to send emails from a specific account but it always sends from my main no matter how much code I try or what I do. Is there any way to tell it to send it from a particular account? I am writing my code in MS Access, but using Outlook objects.

我正在尝试从特定帐户发送电子邮件，但无论我尝试了多少代码或做什么，它总是从我的主帐户发送。有没有办法告诉它从特定帐户发送？我在 MS Access 中编写代码，但使用 Outlook 对象。

Sub testEmail()
    On Error Resume Next
    Set outapp = GetObject(, "Outlook.Application")

    If outapp Is Nothing Then
        Set outapp = CreateObject("Outlook.Application")
    End If


    Set oMail = outapp.CreateItem(olMailItem)

    With oMail
        .To = "[email protected]"
        .Subject = "test2"

        .Send
    End With

    Set outapp = Nothing
    Set oMail = Nothing

End Sub

Updated code:

更新代码：

Option Compare Database

Sub testEmail()
    On Error Resume Next
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(olMailItem)
    Set olAccount = oApp.Account
    Set olAccountTemp = oApp.Account
    Dim foundAccount As Boolean
    Dim strFrom As String
    strFrom = "[email protected]"    

    foundAccount = False
    Set olAccounts = oApp.Application.Session.Accounts
    For Each olAccountTemp In olAccounts
        Debug.Print olAccountTemp.smtpAddress
        If (olAccountTemp.smtpAddress = strFrom) Then
            Set olAccount = olAccountTemp
            foundAccount = True
            Exit For
        End If
    Next

    If foundAccount Then
        Debug.Print "ACCT FOUND!"
        With oMail
            .To = "[email protected]"
            .Body = "Message!"
            .Subject = "test3"
            .sendusingaccount = olAccount
        End With
    Else
        Debug.Print "No acct found"
    End If

    Set oApp = Nothing
    Set oMail = Nothing
    Set olAccounts = Nothing
    Set olAccount = Nothing
    Set olAccountTemp = Nothing
End Sub

回答by Arun Chandralingam

Try using

尝试使用

Set oMail.sendusingaccount=olAccount

instead of

代替

oMail.sendusingaccount=olAccount

It worked for me, your code is perfect, just the Setis missing.

它对我有用，您的代码很完美，只是Set缺少了。

回答by Inet Kemp

It is also much easier when the user can select the email address rather than account number. sendCaller loops through the accounts until it finds this email address. From there on it will call sendFile from where the message will be sent.

当用户可以选择电子邮件地址而不是帐号时，这也容易得多。sendCaller 循环遍历帐户，直到找到此电子邮件地址。从那里开始，它将从发送消息的地方调用 sendFile。

Sub sendCaller()
'creates outlook application
'chooses an email address and finds the corresponding account number

    Dim OutApp As Object
    Dim i As Integer, accNo As Integer

    Set OutApp = CreateObject("Outlook.Application")
    emailToSendTo = "[email protected]"  'put required email address

'if smtp address=email we want to send to, acc no we are looking for is identified
   For i = 1 To OutApp.Session.Accounts.Count
      'Uncomment the Debug.Print command to see all email addresses that belongs to you
       '''Debug.Print "Acc name: " & OutApp.Session.Accounts.Item(i) & " Acc number: " & i & " email: " & OutApp.Session.Accounts.Item(i).smtpAddress
       If OutApp.Session.Accounts.Item(i).smtpAddress = emailToSendTo Then accNo = i
    Next i

    sendFile accNo

End Sub

Sub sendFile(accountNo As Integer)
    Dim OutApp As Object
    Dim OutMail As Object


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    With OutMail

        .To = "[email protected]"
        .Subject = "Test"
        .Body = "Body"
        Set .SendUsingAccount = OutApp.Session.Accounts.Item(accountNo)
        .Send
    End With
End Sub