outlook automation / change e-mail account used to send e-mail

[Philip Leduc]

I am using automation in MS Access to send e-mails through outlook, this is
working fine.
The e-mails are send through the default e-mail account (there is several of
them)

Does anyone knows the code (VBA) to choose/select the account with which the
e-mail will be sent?

Thanks

Philip

used code below, somehow there must be a property to be changed so it
selects a different e-mail account
I took the code out of another application of mine, that is why some stuff
is taken out as text

Private Sub cmdEmails_Click()
'On Error GoTo Err_cmdEmails_Click

Dim objOL As Outlook.Application
Dim objOLmsg As Outlook.MailItem
Dim objOLRecip As Outlook.Recipient
Dim objOLattach As Outlook.Attachment
Dim intCounter As Integer, intTotal As Integer
Dim Email As String
Dim strBody As String
Dim StrAttach As String


Dim rs As ADODB.Recordset

Set rs = New ADODB.Recordset
rs.ActiveConnection = CurrentProject.Connection
rs.Open "Select * from QryMember"

'create the outlook session
Set objOL = CreateObject("Outlook.Application")

intCounter = 0
intTotal = 0
Email = ""
strBody = ""
Do Until rs.EOF
'add 1 to counter if we are going to the loop to limit nbr e-mails
send together
intCounter = intCounter + 1
'add 1 to counter off all send messages
intTotal = intTotal + 1
'create the message
Set objOLmsg = objOL.CreateItem(olMailItem)

With objOLmsg
'add the recipient to the message, select one of four possible
e-mails
'first contact in relation has no e-mail
Email = rs!
'Build Message in body

'add Attachment
'StrAttach = "C:\Documents and Settings\"
'StrAttach = StrAttach & rs![MesImage]
'change names on top of body in function of couple of persons

strBody = ""
If IsNull(rs![FName]) Then
strBody = strBody & "Dear " & rs![Name] & "<p>"
Else
strBody = strBody & "Dear " & rs![FName] & "<p>"
End If


strBody = strBody & rs![mesbody] & "<br>"

'strBody = strBody & rs![MailURLhelp] & ": " & "<a href='" &
rs![MailURL] & "'>" & rs![MailURL] & "</a>" & "<p>"

'strBody = strBody & "<img src='" & rs![MesImage] & "'>"

Set objOLRecip = .Recipients.Add(Email)
objOLRecip.Type = olTo 'or olCC for copy to
'set the subject, body and importance of the message
.Subject = rs![MesSubject]
'when working with textbody
'.Body = strBody
'when working with a HTML body
.HTMLBody = strBody
.Importance = olImportanceNormal
'add attachment when present
If Len(StrAttach) > 0 Then
Set objOLattach = .Attachments.Add(StrAttach)
End If
'.DeleteAfterSubmit = True
.Send
End With
Email = ""
strBody = ""
rs.MoveNext

'send "intcounter" nbr of e-mails at the time, then pause
"pauzetime" seconds
If intCounter = 4 Then
'timer
Dim PauseTime, Start, Finish, TotalTime
'If (MsgBox("Press Yes to pause for 5 seconds", 4)) = vbYes Then
PauseTime = 45 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.
'TotalTime = Finish - Start ' Calculate total time.
'MsgBox "Paused for " & TotalTime & " seconds"
'Else
'End
'End If

'reset intcounter to 0
intCounter = 0
End If

Loop
'send message to user when finished
MsgBox intTotal & " ready to send"


'Exit_cmdEmails_Click:
'Exit Sub

'Err_cmdEmails_Click:
'MsgBox Err.Description
'Resume Exit_cmdEmails_Click

End Sub

 

[Ken Slovak - [MVP - Outlook]]

This would be better posted in the microsoft.public.outlook.program_vba
group.

You don't say what version or mode of Outlook you are using. In Outlook 98
or 2000 in Internet Only mode you can select the sending account by getting
the menu item that would allow you to do that in the UI as a
CommandBarButton or control and calling its Execute method. That would also
work for Outlook 2002 and 2003. This will not work in Outlook 98 or 2000 in
corporate/workgroup mode or in Outlook 97.

In addition, in secure versions of Outlook you would fire the security
prompts if you send programmatically like that.

See http://www.slovaktech.com/code_samples.htm#SendReceive for some examples
of sending using the CommandBar objects, you can modify code like that to do
what you want. The second and third examples of sending/receiving are the
ones relevant to your question.

I am using automation in MS Access to send e-mails through outlook, this is
working fine.
The e-mails are send through the default e-mail account (there is several of
them)

Does anyone knows the code (VBA) to choose/select the account with which the
e-mail will be sent?

Thanks

Philip

used code below, somehow there must be a property to be changed so it
selects a different e-mail account
I took the code out of another application of mine, that is why some stuff
is taken out as text

Private Sub cmdEmails_Click()
'On Error GoTo Err_cmdEmails_Click

Dim objOL As Outlook.Application
Dim objOLmsg As Outlook.MailItem
Dim objOLRecip As Outlook.Recipient
Dim objOLattach As Outlook.Attachment
Dim intCounter As Integer, intTotal As Integer
Dim Email As String
Dim strBody As String
Dim StrAttach As String


Dim rs As ADODB.Recordset

Set rs = New ADODB.Recordset
rs.ActiveConnection = CurrentProject.Connection
rs.Open "Select * from QryMember"

'create the outlook session
Set objOL = CreateObject("Outlook.Application")

intCounter = 0
intTotal = 0
Email = ""
strBody = ""
Do Until rs.EOF
'add 1 to counter if we are going to the loop to limit nbr e-mails
send together
intCounter = intCounter + 1
'add 1 to counter off all send messages
intTotal = intTotal + 1
'create the message
Set objOLmsg = objOL.CreateItem(olMailItem)

With objOLmsg
'add the recipient to the message, select one of four possible
e-mails
'first contact in relation has no e-mail
Email = rs!
'Build Message in body

'add Attachment
'StrAttach = "C:\Documents and Settings\"
'StrAttach = StrAttach & rs![MesImage]
'change names on top of body in function of couple of persons

strBody = ""
If IsNull(rs![FName]) Then
strBody = strBody & "Dear " & rs![Name] & "<p>"
Else
strBody = strBody & "Dear " & rs![FName] & "<p>"
End If


strBody = strBody & rs![mesbody] & "<br>"

'strBody = strBody & rs![MailURLhelp] & ": " & "<a href='" &
rs![MailURL] & "'>" & rs![MailURL] & "</a>" & "<p>"

'strBody = strBody & "<img src='" & rs![MesImage] & "'>"

Set objOLRecip = .Recipients.Add(Email)
objOLRecip.Type = olTo 'or olCC for copy to
'set the subject, body and importance of the message
.Subject = rs![MesSubject]
'when working with textbody
'.Body = strBody
'when working with a HTML body
.HTMLBody = strBody
.Importance = olImportanceNormal
'add attachment when present
If Len(StrAttach) > 0 Then
Set objOLattach = .Attachments.Add(StrAttach)
End If
'.DeleteAfterSubmit = True
.Send
End With
Email = ""
strBody = ""
rs.MoveNext

'send "intcounter" nbr of e-mails at the time, then pause
"pauzetime" seconds
If intCounter = 4 Then
'timer
Dim PauseTime, Start, Finish, TotalTime
'If (MsgBox("Press Yes to pause for 5 seconds", 4)) = vbYes Then
PauseTime = 45 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.
'TotalTime = Finish - Start ' Calculate total time.
'MsgBox "Paused for " & TotalTime & " seconds"
'Else
'End
'End If

'reset intcounter to 0
intCounter = 0
End If

Loop
'send message to user when finished
MsgBox intTotal & " ready to send"


'Exit_cmdEmails_Click:
'Exit Sub

'Err_cmdEmails_Click:
'MsgBox Err.Description
'Resume Exit_cmdEmails_Click

End Sub
[/QUOTE]