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

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?

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

To clarify it is the "From " (and therefore the reply address) that needs to be different in each instance.

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?

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")

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

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

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!

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

I dont know if this is readonly property or perhaps u can set them

Regarding CDO
I found this

http://64.233.183.104/search?q=cache:9SV_py00QYUJ:msdn.microsoft.com/library/en-us/cdosys/html/_cdosys_ibodypart_getdecodedcontentstream.asp+cdo+adostream&hl=en&gl=uk&ct=clnk&cd=1

Dont know if it will help

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???!!!???

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!

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.

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