Solved

Send email from Access VBA using multiple email addresses on the same PC

Posted on 2006-06-12
20
663 Views
Last Modified: 2012-06-21
Hi,

I have a client who has a number of companies and their marketing department need to send email out from 4 different domains.

I can happily use VBA to create an email that is sent using Outlook (I use redemption to do this)

Can anyone suggest how I might sent an email using a different account depending on what the user has selected?
0
Comment
Question by:pauldonson
20 Comments
 
LVL 84

Accepted Solution

by:
Scott McDaniel (Microsoft Access MVP - EE MVE ) earned 168 total points
ID: 16886290
There's a post in the FAQ for Redemption concerning this:

http://www.dimastr.com/redemption/

It's the last one, or second to last one
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16886294
Different account? do you just need to register a different FROM email address
or use a different STMP server?

If so, have u looked into using CDO?

0
 
LVL 34

Expert Comment

by:jefftwilley
ID: 16886298
To clarify,
You want the "From" adressee to be different for each mailing? Or you want more than one "TO" addressed to appear on each e-mail?
J
0
 
LVL 38

Assisted Solution

by:Jim P.
Jim P. earned 166 total points
ID: 16886305
Here's a way e (http:/Q_20699546.html) to do SMTP e-mail from Access instead of using Outlook.  That way you avoid the problems of having to click the Yest to send and can use whatever domain you want.
0
 

Author Comment

by:pauldonson
ID: 16886421
To clarify it is the "From " (and therefore the reply address) that needs to be different in each instance.
0
 
LVL 65

Assisted Solution

by:rockiroads
rockiroads earned 166 total points
ID: 16886430
This is my example using CDO, and it explains the 2 points I mentioned in my first post



Public Function SendEmailCDO(ByVal strTo As String, _
                          ByVal strMessage As String, _
                          ByVal strSubject As String, _
                          Optional ByVal strAttach As String)

    Dim objEmail As Object
   
   
    On Error Resume Next
   
    Set objEmail = CreateObject("CDO.Message")


    '**** SET EMAIL ADDRESS OF SENDER HERE
    objEmail.From = "fred@smith.com"      


    objEmail.To = strTo
    objEmail.Subject = strSubject
    objEmail.TextBody = strMessage
    if strAttach <> "" then objEmail.AddAttachment strAttach
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

    '**** HERE YOU ENTER THE SMTP SERVER e.g. smtp.xxx.com
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.xx.com"

    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objEmail.Configuration.Fields.Update
    objEmail.Send

    If Err.Number <> 0 Then
        MsgBox "Error in sending. " & Err.Description
    Else
        MsgBox "Sent"   'remove this if u dont want confirmation
    End If
    Set objEmail = Nothing

End Function
0
 

Author Comment

by:pauldonson
ID: 16886511
rockiroads:

That works fine! Thanks for that - TBH I haven't a clue what it is doing but I like it! Bit worried about the references to scemas.microsoft.com - what are they all about?
0
 

Author Comment

by:pauldonson
ID: 16886575
Rockiroads: My current code using redemption and Outlook allows me to save a copy of the email for it to be imported into my SQL database. Is there a way of adapting your function to do this but Access comes up with an error if I insert the line objEmail.SaveAs ("C:\Test.msg")
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16886597
Cool

CDO is a Microsoft thing and those links seem to be reading up/setting up some parameters for CDO. I had a look briefly but couldnt come up with much.
I use this and normally give this out as my example mostly along with Outlook Automation.
CDO does not go via outlook, instead goes straight to server.

Note this though
http://www.microsoft.com/downloads/details.aspx?FamilyID=2714320d-c997-4de1-986f-24f081725d36&displaylang=en



0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 65

Expert Comment

by:rockiroads
ID: 16886642
ok, I didnt know u wanted to save the message as well

I dont believe you can save messages as a message file
What is it you need to store, could u not write directly to the database given the info u got?
or do u have some process that reads the outlook message files and inserts into db

0
 

Author Comment

by:pauldonson
ID: 16886712
I currently construct the email and save it on the hard disk as an MSG file and then use ADODB.Stream to send it to the SQL database, this then neatly keeps it in the format in which it was sent together with attachments.

I have had a look at the FAQ on the Redemption site as suggested by LMConsulting but I can't make head nor tail of it!
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16886843
Looking at Redemption

there seems to be this that u could possibly use


SafeMailItem.Sender.Address

or

SafeMailItem.Fields(PR_SENDER_EMAIL_ADDRESS).

or

SafeMailItem.SenderEmailAddress


0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16886877
I dont know if this is readonly property or perhaps u can set them
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16886918
0
 

Author Comment

by:pauldonson
ID: 16886923
OK. I got excited then!

The first one failed, the second one was ignored and the third one is read only.

I have tried the solution in the Redemption FAQ and the mail always bounces back as undeliverable (I presume our server won't authorise the "spoofed" email address I am using)

Why do these seemingly simple problems take forever to sort out???!!!???
0
 

Author Comment

by:pauldonson
ID: 16886980
Right, got that working now and it saves it.

This is where I am at:

Dim objEmail As Object
   
   
    On Error Resume Next
   
    Set objEmail = CreateObject("CDO.Message")

    '**** SET EMAIL ADDRESS OF SENDER HERE
    objEmail.From = "spoofed@yahoo.co.uk"


    objEmail.To = "spoof@Spoof.co.uk"
    objEmail.subject = "Spoof Test"
    objEmail.TextBody = "Spoof test should be from Yahoo"
    'If strAttach <> "" Then objEmail.AddAttachment strAttach
    objEmail.Configuration.Fields.item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

    '**** HERE YOU ENTER THE SMTP SERVER e.g. smtp.xxx.com
    objEmail.Configuration.Fields.item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "MAILSERVER"

    objEmail.Configuration.Fields.item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objEmail.Configuration.Fields.Update
    objEmail.getstream.SaveToFile "C:\Test.eml", adSaveCreateOverWrite
    objEmail.Send
   
    If Err.Number <> 0 Then
        MsgBox "Error in sending. " & Err.Description
    Else
        MsgBox "Sent"   'remove this if u dont want confirmation
    End If
    Set objEmail = Nothing



My next issue is I need it in MSG format (so it can be opened with Outlook) - eml will only open with Outlook Express which none of my clients have configured.

If I open the eml file with Outlook it creates a new email message with the eml as an attachment. If I save it as an MSG it won't open it.

Grrr! I think we might be close now, I will have to catch up with you tomorrow, about to be chucked out of the building now!

0
 

Author Comment

by:pauldonson
ID: 16892178
Is there a way of using Outlook Accounts to send the emails? The PCs are set up with multiple accounts anyway and if I could simply choose the correct one then problem solved.
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16892876
There must be a simple eml to msg conversion code/tool out there.
e.g. http://www.outlookextract.com/ - this u have to pay for but it does mean that there is stuff out there

Sorry the CDO thing didnt work out then

This code uses Outlook Automation, Im afraid though, you may get the security warning though, but it does use Outlook
I was unable to find anything regarding setting Sender details


Public Function SendRRMailEE(ByVal sReceipient, _
                           ByVal sSubject As String, _
                           ByVal sBodyText As String, _
                           ByVal sAttachment As String) As Boolean

    Dim objOutlook As Object
    Dim objEmailMessage As Object
   
   
    'Specify error handler
    On Error GoTo SMError
   
    'If no receipient passed then exit with error
    If Trim$(sReceipient) = "" Then
        MsgBox "No Receipient name has been specified", vbExclamation, "Send Mail"
        Exit Function
    End If
   
   
    'Create outlook objects
    'note, you need to add the Outlook reference in Modules Menu option Tools/References
    Set objOutlook = CreateObject("Outlook.Application")
    Set objEmailMessage = objOutlook.CreateItem(0)
   
    'Set subject if specified
    If sSubject <> "" Then objEmailMessage.Subject = sSubject else objEmailMessage.Subject = "Automated Email"
   
    'If message body specified then add that
    objEmailMessage.Body = sBodyText
   
    objEmailMessage.ReadReceiptRequested = True
    objEmailMessage.OriginatorDeliveryReportRequested = True
   
    'If attachment passed then add that
    If sAttachment <> "" Then objEmailMessage.Attachments.Add sAttachment
   
    'Set the email object
    objEmailMessage.Recipients.Add sReceipient

    'Resolve email address
    objEmailMessage.Recipients.ResolveAll
   
    'Display email - diagnostic purposes only - otherwise comment out
    objEmailMessage.Display
   
    objEmailMessage.send
   
    'MsgBox "Message has been successfully sent", vbInformation, "Send Mail"
   
    'Return success
    SendRRMailEE = True
    GoTo SMDone
 
SMError:
    'Return failure and display error message
    SendRRMailEE = False
    MsgBox "An error occurred when trying to send the email." & vbCrLf & vbCrLf & Err.Description, vbCritical, "Send Mail"

SMDone:
    'Clear down the objects created
    On Error Resume Next
    Set objEmailMessage = Nothing
    Set objOutlook = Nothing
End Function

0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Today's users almost expect this to happen in all search boxes. After all, if their favourite search engine juggles with tens of thousand keywords while they type, and suggests matching phrases on the fly, why shouldn't they expect the same from you…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now