Sending email through MS access (using non default Outlook email accounts)

**talhaparvaiz@yahoo.com** · 06-13-2020, 02:35 PM

Hi, here is some background on the issue

I am using the VB code documented below to send out emails through Outlook.
Outlook has 3 email accounts configured and code uses the default to send emails
ALL IS WORKING FINE TO THIS POINT
Now, I don't want to use the default email address when sending out emails. instead, want to use one of the non-default ones.
I am using MS Access 2013 and Outlook 2013

Code:

Option Compare Database

Sub Command0_Click()


Dim sFileName As String, sEmail As String, BccEmail As String, eBody As String
Dim rst As DAO.Recordset




Set rst = CurrentDb.OpenRecordset("tbl_Email", dbOpenSnapshot) ' Table Name


eBody = "<HTML><BODY>Note</BODY></HTML>"




On Error Resume Next
rst.MoveFirst




Dim i As Integer
Dim x As Integer


For i = 1 To 500 'sending emails individually


    sEmail = rst("Email_Address")  'Field Name
    CCEmail = sEmail
    BccEmail = ""
    
    
        For x = 1 To 40 'Adding 40 email addreses to BCC
    If Not rst.EOF Then
    BccEmail = BccEmail & ";" & sEmail
    rst.MoveNext
    sEmail = rst("Email_Address")
    End If
    Next x
    
    If BccEmail <> "" Then
    Call vcSendEmail_Outlook_With_Attachment("Subject", "info@toemail.com", "", BccEmail, "\\fs2\Desktop\test.doc", eBody)
    Call Wait_Time
    End If
Next i




rst.Close
Set rst = Nothing
End Sub

Thanks in advance

**June7** · 06-13-2020, 04:06 PM

Explore SentOnBehalfOfName property of email object.

**talhaparvaiz@yahoo.com** · 06-14-2020, 12:51 AM

Originally Posted by June7

Explore SentOnBehalfOfName property of email object.

I have modified following code to use SentOnBehalfOfName function but it didn't work... Please advise

Code:

Option Compare Database


Sub Command0_Click()


Dim sFileName As String, sEmail As String, BccEmail As String, eBody As String
Dim rst As DAO.Recordset




Set rst = CurrentDb.OpenRecordset("tbl_Email", dbOpenSnapshot) ' Table Name


eBody = "<HTML><BODY>Note</BODY></HTML>"




On Error Resume Next
rst.MoveFirst




Dim i As Integer
Dim x As Integer


For i = 1 To 500 'sending emails individually


    sEmail = rst("Email_Address")  'Field Name
    CCEmail = sEmail
    BccEmail = ""
    
    
    
    For x = 1 To 40 'Adding 40 email addreses to BCC
    If Not rst.EOF Then
    BccEmail = BccEmail & ";" & sEmail
    rst.MoveNext
    sEmail = rst("Email_Address")
    End If
    Next x
    
    If BccEmail <> "" Then
    Call vcSendEmail_Outlook_With_Attachment("Subject", "info@toemail.com", "", BccEmail, "\\fs2\Desktop\test.doc", eBody)
    Call Wait_Time
    End If
Next i




rst.Close
Set rst = Nothing
End Sub




----------------------------
----------------------------




Option Compare Database


Sub vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
    Dim OutApp As Object
    Dim OutMail As Object
 
  
    Set OutApp = CreateObject("Outlook.Application")
    
    
    OutApp.Session.Logon
    
    
    Set OutMail = OutApp.CreateItem(0)
 
     OutMail.SentOnBehalfOfName = "email@From.com"
    OutMail.To = sTo
    If sCC <> "" Then OutMail.CC = sCC
    If sBcc <> "" Then OutMail.BCC = sBcc
    OutMail.Subject = sSubject
    If sBody <> "" Then OutMail.HTMLBody = sBody




    OutMail.Attachments.Add (sAttachment)


    SendKeys "^{ENTER}"
    OutMail.Send 'Send | Display
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

**June7** · 06-14-2020, 11:59 AM

What does "didn't work" mean - error message, wrong result, nothing happens?

I've never used this and can't really test it so can only refer to web for guidance.

**talhaparvaiz@yahoo.com** · 06-14-2020, 10:31 PM

Originally Posted by June7

What does "didn't work" mean - error message, wrong result, nothing happens?

I've never used this and can't really test it so can only refer to web for guidance.

Nothing happened... Code just ran and no email was generated.

I have tried a lot of variations but due to my lack of VBA knowledge wasn't able to accomplish much

Please assist

thanks

**Gicu** · 06-15-2020, 11:53 AM

Try to use SendUsingAccount instead of SendOnBehalfOfName:
https://www.slipstick.com/developer/...cific-account/

Note the loop through the Outlook accounts (assumes you have them defined in your Outlook under Accounts).
Some more info on both:
https://stackoverflow.com/questions/...ess-in-outlook
http://www.slipstick.com/developer/c...l-address-vba/
Cheers,
Vlad

**talhaparvaiz@yahoo.com** · 06-16-2020, 01:25 AM

Originally Posted by Gicu

Try to use SendUsingAccount instead of SendOnBehalfOfName:
https://www.slipstick.com/developer/...cific-account/

Note the loop through the Outlook accounts (assumes you have them defined in your Outlook under Accounts).
Some more info on both:
https://stackoverflow.com/questions/...ess-in-outlook
http://www.slipstick.com/developer/c...l-address-vba/
Cheers,
Vlad

Here are the modifications that I have made to use SendOnBehalfOfName but it's not working. when I run the code nothing happens

Code:

ption Compare Database


Sub Command0_Click()


Dim sFileName As String, sEmail As String, BccEmail As String, eBody As String
Dim rst As DAO.Recordset




Set rst = CurrentDb.OpenRecordset("tbl_Email", dbOpenSnapshot) ' Table Name


eBody = "<HTML><BODY>Note</BODY></HTML>"




On Error Resume Next
rst.MoveFirst




Dim i As Integer
Dim x As Integer


For i = 1 To 500 'sending emails individually


    sEmail = rst("Email_Address")  'Field Name
    CCEmail = sEmail
    BccEmail = ""
    
    
    
    For x = 1 To 40 'Adding 40 email addreses to BCC
    If Not rst.EOF Then
    BccEmail = BccEmail & ";" & sEmail
    rst.MoveNext
    sEmail = rst("Email_Address")
    End If
    Next x
    
    If BccEmail <> "" Then
    Call vcSendEmail_Outlook_With_Attachment("Subject", "info@toemail.com", "", BccEmail, "\\fs2\Desktop\test.doc", eBody)
    Call Wait_Time
    End If
Next i




rst.Close
Set rst = Nothing
End Sub




----------------------------
----------------------------




Option Compare Database


Sub vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
    Dim OutApp As Object
    Dim OutMail As Object
 
  
    Set OutApp = CreateObject("Outlook.Application")
    
    
    OutApp.Session.Logon
    
    
    Set OutMail = OutApp.CreateItem(0)
 
 OutMail.To = sTo
    If sCC <> "" Then OutMail.CC = sCC
    If sBcc <> "" Then OutMail.BCC = sBcc
    OutMail.Subject = sSubject
    If sBody <> "" Then OutMail.HTMLBody = sBody




    OutMail.Attachments.Add (sAttachment)

    OutMail.SendUsingAccount = "From@Email.com"   

    SendKeys "^{ENTER}"
    OutMail.Send


    
    

    Set OutMail = Nothing
    Set OutApp = Nothing End Sub

Please advise

Thanks

**Gicu** · 06-16-2020, 11:24 AM

Have you looked at the links I've included? You need to loop through the accounts until you find the one you want to use, can you try this:

Code:

Sub vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
Dim OutApp As Object
Dim OutMail As Object
Dim oAccount As Object 'Outlook.Account
 
  
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon


For Each oAccount In OutApp.Session.Accounts
   If oAccount = "From@Email.com" Then    'replace with valid email
    	Set OutMail = OutApp.CreateItem(0)
    	outMail.SendUsingAccount = oAccount 
    	OutMail.To = sTo
    	If sCC <> "" Then OutMail.CC = sCC
    	If sBcc <> "" Then OutMail.BCC = sBcc
    	OutMail.Subject = sSubject
    	If sBody <> "" Then OutMail.HTMLBody = sBody
    	OutMail.Attachments.Add (sAttachment)
    	OutMail.Send
   End If
Next   


Set OutMail = Nothing
Set OutApp = Nothing 


End Sub

Cheers,

**talhaparvaiz@yahoo.com** · 06-16-2020, 07:06 PM

Originally Posted by Gicu

Have you looked at the links I've included? You need to loop through the accounts until you find the one you want to use, can you try this:

Code:

Sub vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
Dim OutApp As Object
Dim OutMail As Object
Dim oAccount As Object 'Outlook.Account
 
  
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon


For Each oAccount In OutApp.Session.Accounts
   If oAccount = "From@Email.com" Then    'replace with valid email
        Set OutMail = OutApp.CreateItem(0)
        outMail.SendUsingAccount = oAccount 
        OutMail.To = sTo
        If sCC <> "" Then OutMail.CC = sCC
        If sBcc <> "" Then OutMail.BCC = sBcc
        OutMail.Subject = sSubject
        If sBody <> "" Then OutMail.HTMLBody = sBody
        OutMail.Attachments.Add (sAttachment)
        OutMail.Send
   End If
Next   


Set OutMail = Nothing
Set OutApp = Nothing 


End Sub

Cheers,

Code ran with no results... I have attached my access DB for your review. Thanks

Send Bulk Email - Test.zip

**June7** · 06-16-2020, 07:19 PM

You have not replaced "From@Email.com" with whatever you want as a valid email. However, even with that fixed, I am not getting emails. I have never needed to use Sleep and Do Events with Outlook automation. Use Display instead of Send until you are sure code works.

I step debugged and as soon as OutMail.SendUsingAccount = oAccount is executed, code exits that If block and goes back to button event. Never even gets to Send method.

Try using:

Set OutMail.SendUsingAccount = oAccount

**talhaparvaiz@yahoo.com** · 06-17-2020, 11:56 PM

Originally Posted by June7

You have not replaced "From@Email.com" with whatever you want as a valid email. However, even with that fixed, I am not getting emails. I have never needed to use Sleep and Do Events with Outlook automation. Use Display instead of Send until you are sure code works.

I step debugged and as soon as OutMail.SendUsingAccount = oAccount is executed, code exits that If block and goes back to button event. Never even gets to Send method.

Try using:

Set OutMail.SendUsingAccount = oAccount

I have made following 3 changes to the code:

- If oAccount = "From@Email.com" Then 'replaced with valid email
- Set outMail.SendUsingAccount = oAccount
- Outmail.Display

Here are my findings/challenges:

- When I use Outmail.Display, then the email is created with all required information populated (From email, to email, subject, etc.)
- When I use Outmail.Send, then nothing happens (no email is created or sen

Here is the updated code

Code:

Sub vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
Dim OutApp As Object
Dim OutMail As Object
Dim oAccount As Object 'Outlook.Account
 
  
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon


For Each oAccount In OutApp.Session.Accounts
   If oAccount = "From@Email.com" Then    'replace with valid email
        Set OutMail = OutApp.CreateItem(0)
      Set outMail.SendUsingAccount = oAccount 
        OutMail.To = sTo
        If sCC <> "" Then OutMail.CC = sCC
        If sBcc <> "" Then OutMail.BCC = sBcc
        OutMail.Subject = sSubject
        If sBody <> "" Then OutMail.HTMLBody = sBody
        OutMail.Attachments.Add (sAttachment)
        OutMail.Display
   End If
Next   


Set OutMail = Nothing
Set OutApp = Nothing

**June7** · 06-18-2020, 10:25 AM

How do you know it isn't sent? Did you go check the Sent folder of that account?

I don't have another account I can test with so this is really all I can offer.

**Gicu** · 06-18-2020, 10:51 AM

Is that a shared maillbox? See https://support.microsoft.com/en-us/...rs=en-us&ad=us
Exchange server? https://kb.intermedia.net/Article/1633
You could try the suggestions in this forums (note that the use the SendKeys is not usually recommended):
https://stackoverflow.com/questions/...ient-when-clos
https://stackoverflow.com/questions/...ng-word-editor
https://stackoverflow.com/questions/...d-method-fails

Code:


Sub vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
Dim OutApp As Object
Dim OutMail As Object
Dim oAccount As Object 'Outlook.Account
Dim oNS as Object

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set oNS =OutApp.GetNamespace("MAPI")
oNS.Logon

For Each oAccount In OutApp.Session.Accounts
   If oAccount = "From@Email.com" Then    'replace with valid email
        Set OutMail = OutApp.CreateItem(0)
      Set outMail.SendUsingAccount = oAccount 
        OutMail.To = sTo
        If sCC <> "" Then OutMail.CC = sCC
        If sBcc <> "" Then OutMail.BCC = sBcc
        OutMail.Subject = sSubject
        If sBody <> "" Then OutMail.HTMLBody = sBody
        OutMail.Attachments.Add (sAttachment)
        OutMail.Display
   End If
Next   




Set OutMail = Nothing
Set OutApp = Nothing
[/COLOR]

I added the NameSpace logon as suggested in one of the links, please give it a try.

**talhaparvaiz@yahoo.com** · 06-18-2020, 07:46 PM

Originally Posted by Gicu

Is that a shared maillbox? See https://support.microsoft.com/en-us/...rs=en-us&ad=us
Exchange server? https://kb.intermedia.net/Article/1633
You could try the suggestions in this forums (note that the use the SendKeys is not usually recommended):
https://stackoverflow.com/questions/...ient-when-clos
https://stackoverflow.com/questions/...ng-word-editor
https://stackoverflow.com/questions/...d-method-fails

Code:


Sub vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
Dim OutApp As Object
Dim OutMail As Object
Dim oAccount As Object 'Outlook.Account
Dim oNS as Object

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set oNS =OutApp.GetNamespace("MAPI")
oNS.Logon

For Each oAccount In OutApp.Session.Accounts
   If oAccount = "From@Email.com" Then    'replace with valid email
        Set OutMail = OutApp.CreateItem(0)
      Set outMail.SendUsingAccount = oAccount 
        OutMail.To = sTo
        If sCC <> "" Then OutMail.CC = sCC
        If sBcc <> "" Then OutMail.BCC = sBcc
        OutMail.Subject = sSubject
        If sBody <> "" Then OutMail.HTMLBody = sBody
        OutMail.Attachments.Add (sAttachment)
        OutMail.Display
   End If
Next   




Set OutMail = Nothing
Set OutApp = Nothing
[/COLOR]

I added the NameSpace logon as suggested in one of the links, please give it a try.

It worked... Yahoooooooooooooooooooooooo!

Thank you so much for your assistance

**Gicu** · 06-19-2020, 03:44 PM

You're very welcome, good luck with your project!

Cheers,

Sending email through MS access (using non default Outlook email accounts)

Thread Tools

Sending email through MS access (using non default Outlook email accounts)

Similar Threads

Sending Email from Access using Outlook

Sending a value from Access to Outlook email

Sending email with Access through Outlook using HTML body

How to disable Outlook Pop Up Notification when sending Email Via Access 2016?

Sending email from access to outlook...gives permission denied

Posting Permissions