Vba MS Access/Outlook 2010-如何选择从哪个帐户发送电子邮件?
我试图从一个特定的帐户发送电子邮件,但无论我尝试了多少代码或做了什么,它总是从我的主帐户发送。有没有办法告诉它从某个特定帐户发送?我正在MS Access中编写代码,但使用Outlook对象Vba MS Access/Outlook 2010-如何选择从哪个帐户发送电子邮件?,vba,ms-access,outlook,Vba,Ms Access,Outlook,我试图从一个特定的帐户发送电子邮件,但无论我尝试了多少代码或做了什么,它总是从我的主帐户发送。有没有办法告诉它从某个特定帐户发送?我正在MS Access中编写代码,但使用Outlook对象 Sub testEmail() On Error Resume Next Set outapp = GetObject(, "Outlook.Application") If outapp Is Nothing Then Set outapp = CreateObj
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 = "randomaddress@randomdomain.com"
.Subject = "test2"
.Send
End With
Set outapp = Nothing
Set oMail = Nothing
End Sub
更新代码:
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 = "FROMADDY@randomaddress.com"
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 = "randomaddress@random.com"
.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
试用
Set oMail.sendusingaccount=olAccount
而不是
oMail.sendusingaccount=olAccount
这对我很有用,你的代码很完美,只是缺少了
集 当用户可以选择电子邮件地址而不是帐号时,这也会容易得多。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 = "name@domain.com" '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 = "recipient@domain.com"
.Subject = "Test"
.Body = "Body"
Set .SendUsingAccount = OutApp.Session.Accounts.Item(accountNo)
.Send
End With
End Sub
是否正在设置MailItem.SendUsingAccount属性?请显示您的代码。@DmitryStreblechenko我添加了代码。有没有办法告诉它打开Outlook并发送?现在我必须打开Outlook,然后从Access运行此代码,而Access不是ideal@JohnSmith请查看此内容,因为它引用了SendUsingAccount属性Dmitry提到的@Sorceri似乎不允许我直接指定帐户。它只是在一些打开的会话中循环使用帐户。我尝试使用循环,然后根据smtpaddress匹配的时间将帐户设置为与SendUsingAccount一起使用,然后发送,但它找不到其他收件箱,即使我可以在Outlook中清楚地看到它的邮箱