Sending Email from Two Different Addresses

[ed coleman]

Trying to get vba so that my AR Collection person can click on past due customers, look at their account, make comments and then send an email with the account attached. I seem to have that process working well.

My problem stems from the fact that we run two companies with two different email address, and depending on the customer, one or the other should be selected. Currently, only one is selected for ALL customers.

I would appreciate some assistance with programmatically changing the FROM email based on the customer. The code below generates an email, however, it doesn't change the From address based on the company that responsible for the customer.


Private Sub Command10_Click()
Me.Refresh
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strReportName As String
Dim strmessagebody As String
Dim strto As String
Dim appOut As Outlook.Application
Dim oAccount As Outlook.Account
Dim strAccount As String
Dim oMail As Outlook.MailItem 'ADDED 4/11/2019

Set appOut = New Outlook.Application
Set oMail = appOut.CreateItem(olMailItem) 'ADDED 4/11/2019
If Reports!rpt_os_ar_by_cust_except!Text87 = "Boxes Next Day" Then
strAccount = Reports!rpt_os_ar_by_cust_except!Text12 & "@boxesnextday.com"
Else
strAccount = Reports!rpt_os_ar_by_cust_except!Text12 & "@colemancontainers.com"
End If

Set oAccount = appOut.Session.Accounts(strAccount)

strReportName = "rpt_os_ar_by_cust_except"

strmessagebody = IIf(IsNull(Forms!frmselcommentsforemail!Text5), "", Forms!frmselcommentsforemail!Text5)
strto = Reports!rpt_os_ar_by_cust_except!Text124
'Debug.Print Reports!rpt_os_ar_by_cust_except!Text124
Me.Refresh
strBody = "<P STYLE='font-family:calibri;font-size:14.5px'/P>"
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, CurrentProject.Path & "" & strReportName & ".pdf", False

'******************************* USER DEFINED SECTION ********************************
strSubject = "Outstanding Invoices"
'*************************************************************************************

With oMail
'On Error Resume Next
.To = strto
.cc = Reports!rpt_os_ar_by_cust_except!Text126

.HTMLBody = strBody & "Attn:  " & Reports!rpt_os_ar_by_cust_except.Text122 & "," & (Chr(13) + Chr(10)) & (Chr(13) + Chr(10)) & "<br>" & "<br>" & strmessagebody
.Subject = strSubject & " for " & Reports!rpt_os_ar_by_cust_except!CSNAME & " (This is a " & Reports!rpt_os_ar_by_cust_except!Text87 & " Company)"
.Attachments.Add CurrentProject.Path & "" & strReportName & ".pdf"
'Set .SendUsingAccount = oAccount
.Display 'VIEW email before sending
'.Send 'Immediately Sends the E-Mail without displaying Outlook
End With

Set oAccount = Nothing
Set appOut = Nothing

DoCmd.Close acReport, "rpt_os_ar_by_cust_except"

DoCmd.Close acForm, "frmselcommentsforemail"
End Sub

 

[Gasman]

Try SendUsingAccount

https://docs.microsoft.com/en-us/office/vba/api/outlook.mailitem.sendusingaccount

Alternatively a Template with the other account will do the same.

HTH

 

[ed coleman]

Thanks Gasman, but got the following error when setting that line to:

Set .SendUsingAccount = oAccount.


Error: Run-time error '91': Oject variable or With block variable not set.


I want the vba to pick up the address based on the customer.

 

[Gasman]

I think you would need to check the name of the account before selecting it.?
I see that you did have that, but commented out.

You work out which account to use depending on Reports!rpt_os_ar_by_cust_except!Text87 then walk through the accounts as that link does until you get the correct one.

I would also step through the code line by line making sure everything is set as you think it is.

HTH

 

[Gasman]

I've just copied that code, changed the test to DisplayName to get an account I want and I get the same error:banghead:

Sorry, I took MS docs to work as posted.

 

[Gasman]

Minty helped another user about this

https://access-programmers.co.uk/forums/showthread.php?t=299542

however I have taken that code and whilst it selects the correct account it still does not set the SendUsing property.

When I had to do this I was using 2003 and that did not have SendUsing, so I just used a template, and that worked fine.

You might want to try that method?, though if you have signatures, it can get a little messy.?

Below is my code to send on another account.
You will need to weed out the non relevant code. I do not want to edit in case I make a mistake, as it works as shown.

HTH

Private Sub cmdEmail_Click()
    On Error GoTo Err_Handler
    ' Automate the routine to send notifications of Payments and deposits for clients
    Dim strFilter As String, strClientType As String
    Dim strDate As String, strSQLEmail As String
    Dim strType As String, strClient As String, str3rdID As String, str3rdParty As String, str3rdPartyType As String, strAmount As String, strRef As String, strMethod As String
    Dim strCaseWorker As String, strDatetype As String, strPad As String, strEndPad As String, strPadCol As String, strBlankLine As String, strNotes As String
    Dim strBalance As String
    Dim iColon As Integer
    Dim lngCurrentRec As Long
    Dim blnDisplayMsg As Boolean, blnSameEmail As Boolean
    Dim db As Database
    Dim rs As DAO.Recordset, rsCW As DAO.Recordset
    Dim blnSameClientType As Boolean

    ' Now the Outlook variables
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim strSigPath As String, strSignature As String, strAttachFile As String
    Dim strHeader As String, strFooter As String, strBody As String, strTemplatePath As String, strAppdata As String
    Dim intBody As Integer

    ' Set up HTML tags
    strPad = "<tr><td>"
    strEndPad = "</td></tr>"
    strPadCol = "</td><td>"
    strBlankLine = "<tr></tr>"


    On Error GoTo Err_Handler

    'Establish all the static Outlook Data

    ' Get appdata path
    strAppdata = Environ("Appdata")
    
    ' Set paths
    strTemplatePath = strAppdata & "\Microsoft\Templates"
    strSigPath = strAppdata & "\Microsoft\Signatures\Ssafa.htm"
    
    
    'Get the signature if it exists
    If Dir(strSigPath) <> "" Then
        strSignature = GetBoiler(strSigPath)
        intBody = InStr(strSignature, "<div class=WordSection1>")
        'intBody = InStr(strSignature, "<BODY>")
        strHeader = Left(strSignature, intBody + 24) ' 5
        strFooter = Mid(strSignature, intBody + 24) ' 6
    End If

    ' See if Outlook is open, otherwise open it
    'If fIsOutlookRunning = False Then
    Set objOutlook = CreateObject("Outlook.Application")
    'Call OpenOutlook
    'Pause (5)
    ' Else
    'Set objOutlook = GetObject(, "Outlook.Application")
    'End If
    
    ' Make sure we save any changed data and then get recordset
    If Me.Dirty Then Me.Dirty = False
    ' Update the status bar
    SetStatusBar ("Collecting records.....")

    strSQLEmail = "SELECT  Format([TransactionDate],""yyyymmdd"") & Format([ID],""000000"") AS UKey, Emails.* From Emails "
    strSQLEmail = strSQLEmail & "WHERE (((Emails.EmailStatus) = 'Yes')) "
    'strSQLEmail = strSQLEmail & "ORDER BY Emails.Client, Emails.TranType, Emails.ID, Emails.TransactionDate;"
    strSQLEmail = strSQLEmail & "ORDER BY Emails.Client, Emails.TranType, Format([TransactionDate],""yyyymmdd"") & Format([ID],""000000"") ;"

    ' Create the Outlook session.
    'Set objOutlook = GetObject(, "Outlook.Application")
    'Set objOutlook = New Outlook.Application
    
    ' Open lookup table for Email CC Name (normally a Case Worker)
    Set db = CurrentDb
    Set rsCW = db.OpenRecordset("SELECT * from Lookups WHERE DataType = 'Email'")
    ' Save the current record position
    lngCurrentRec = Me.CurrentRecord
    ' Now get the data for the emails
    Set rs = db.OpenRecordset(strSQLEmail)
    
    ' Now set the filter to get just the rows we want
    ' strFilter = "Yes"
    
    ' Me.Filter = "EmailStatus = """ & strFilter & """"
    'Me.FilterOn = True


    ' Decide whether to display or just send emails
    blnDisplayMsg = Me.chkDisplay

    'Set rs = Me.RecordsetClone
    rs.MoveFirst

    SetStatusBar ("Creating Emails.....")
    ' Now walk through each record
    Do While Not rs.EOF
        ' Set flag and field to check
        blnSameClientType = True
        strClientType = rs!Client & rs!TranType
        strType = rs!TranType
        
        ' Create the message if first time we are in a different client or tran type.
        'Set objOutlookMsg = objOutlook.CreateItemFromTemplate(strTemplatePath & "\SSAFA Email.oft")
        Set objOutlookMsg = objOutlook.CreateItemFromTemplate(strTemplatePath & "\SSAFA Email.oft")
        With objOutlookMsg
            ' Set the category
            .Categories = "SSAFA"
            .Importance = olImportanceHigh
            ' Add the To recipient(s) to the message.
            Set objOutlookRecip = .Recipients.Add("Jim Needs - Personal")
            objOutlookRecip.Type = olTo
    
            ' Add the CC recipient(s) to the message.
            If rs!CCOffice Then
                Set objOutlookRecip = .Recipients.Add("SSAFA West Glamorgan Branch")
                objOutlookRecip.Type = olCC
            End If
            ' Add Glyn in as BCC for CMS update - 12/02/19
            Set objOutlookRecip = .Recipients.Add("Glyn Davies")
            objOutlookRecip.Type = olBCC

            ' Need to get the Case Worker name from table'
            If rs!CaseWorker > 0 Then
                rsCW.FindFirst "[ID] = " & rs!CaseWorker
                strCaseWorker = rsCW!Data
            Else
                strCaseWorker = ""
            End If

            If strCaseWorker <> "" Then
                Set objOutlookRecip = .Recipients.Add(strCaseWorker)
                objOutlookRecip.Type = olCC
            End If
    
            ' Set the Format, Subject, Body, and Importance of the message.
            '.BodyFormat = olFormatHTML
            strClient = rs!Client


            If strType = "Payment" Then
                .Subject = " Payment Made - " & strClient
            Else
                .Subject = "Deposit Received - " & strClient
            End If
            ' Now start the email with header
            'iColon = InStr(strClient, ":")
            ' If iColon = 0 Then iColon = Len(strClient) + 1
            .HTMLBody = strHeader & "<table border = '0' cellpadding = '5' cellspacing = '5'>"
            '    .HTMLBody = .HTMLBody & "<td>" & "Client: " & strPadCol & Left(strClient, iColon - 1) & strEndPad
            'End If

        End With

        Do While blnSameClientType
            strDate = rs!TransactionDate
            strType = rs!TranType
            str3rdParty = rs!ThirdParty
            strAmount = Format(rs!Amount, "Currency")
            'strBalance = Format(rs!Balance, "Currency")
            'strBalance = Format(DSum("Amount", "Emails", "CMS = " & rs!CMS & " AND ID <= " & rs!ID), "Currency")
            ' Now using unique key Ukey to get correct running balance for entries out of sequence
            strBalance = Format(DSum("Amount", "Emails", "CMS = " & rs!CMS & " AND format(TransactionDate,'yyyymmdd')& format(ID,'000000') <= '" & rs!Ukey & "'"), "Currency")

            'Now Calculated on the fly
            'strBalance = Format(rs!Balance, "Currency") ' was Format(DSum("[Amount]", "Emails", "[CMS]=" & rs!CMS & " AND ID <= " & rs!ID), "Currency")
            
            strRef = rs!Reference
            strMethod = rs!Method
            
            'strDatetype = "Date "
            If strType = "Payment" Then
                str3rdPartyType = "Recipient:"
                strDatetype = "Date Paid:"
            Else
                str3rdPartyType = "From Donor:"
                strDatetype = "Received:"
            End If

            strNotes = Nz(rs!Notes, "")
        
        
            ' Now build the body of the message
            
            ' Make sure we have a colon in client, else use whole field
            
            ' Now add the variable data
            With objOutlookMsg
                .HTMLBody = .HTMLBody & strPad & str3rdPartyType & strPadCol & str3rdParty & strEndPad
                .HTMLBody = .HTMLBody & strPad & strDatetype & strPadCol & strDate & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Method:" & strPadCol & strMethod & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Reference:" & strPadCol & strRef & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Amount:" & strPadCol & strAmount & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Balance:" & strPadCol & strBalance & strEndPad
                ' Add any notes if they exist
                If Len(strNotes) > 0 Then
                    .HTMLBody = .HTMLBody & strPad & "Notes:" & strPadCol & strNotes & strEndPad

                End If
'                ' Add blank line for next set
                .HTMLBody = .HTMLBody & strBlankLine & strBlankLine
            End With
            
            'Now update the record
            rs.Edit
            rs!EmailStatus = "Sent"
            rs!EmailDate = Date
            rs.Update

            ' Now get next record
            rs.MoveNext
            ' Has client or tran type changed?
            If Not rs.EOF Then
                If strClientType = rs!Client & rs!TranType Then
                    blnSameClientType = True
                Else
                    blnSameClientType = False
                End If
            Else
                blnSameClientType = False
            End If
        Loop                                     ' End blnClientType loop
        
        ' Now add the footer
        With objOutlookMsg
            .HTMLBody = .HTMLBody & "</table>" & strFooter
            '.Importance = olImportanceHigh  'High importance
            'Debug.Print strHeader
            'Debug.Print .htmlbody
            'Debug.Print strFooter
            ' Resolve each Recipient's name.
            For Each objOutlookRecip In .Recipients
                objOutlookRecip.Resolve
            Next
    
            ' Should we display the message before sending?
            '.SendUsingAccount = objOutlook.Session.Accounts.Item(4)
            If blnDisplayMsg Then
                .Display
            Else
                .Save
                .Send
            End If
        End With
    
            
    Loop
    ' Switch off the filter and release recordset object, and go back to record we were on
    ' Me.FilterOn = False
    SetStatusBar ("Emails created.....")
    DoCmd.GoToRecord , , acGoTo, lngCurrentRec
    cmdRequery_Click
Proc_Exit:
    Set objOutlook = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookRecip = Nothing
    Set objOutlookAttach = Nothing
    Set rs = Nothing
    Set rsCW = Nothing
    Set db = Nothing
    SetStatusBar (" ")
    Exit Sub
    
Err_Handler:
    MsgBox Err.Number & " " & Err.Description
    Resume Proc_Exit

End Sub
Function GetBoiler(ByVal sFile As String) As String
    'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.ReadAll
    ts.Close
    Set fso = Nothing
    Set ts = Nothing
End Function

 

[Gasman]

OK, finally got a version to work.
I used Minty's find account code from that thread, but modified it to use name of the account, as that was the parameter being passed. Also exited the code when the account was found, as I have quite a few accounts.

HTH

Sub Test2()
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim iAccountIndex As Integer
    
    iAccountIndex = ListEMailAccounts("Gmail")
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    With OutMail                                 ' This creates a blank email and captures the users default signature.
        .BodyFormat = 2                          '2            'olFormatHTML
        .Display
    End With
      
    With OutMail
        .To = "rogercoop@aol.com"
        .CC = ""
        .BCC = ""
        .Subject = "test 2"
        .SendUsingAccount = OutApp.Session.Accounts.Item(iAccountIndex)
        '.From 2
        '.Attachments.Add (VarAttachFile)
        '.HTMLBody = "test"
        .Send
        '.ReadReceiptRequested = False
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


Public Function ListEMailAccounts(AcctToUSe As String) As Integer
    Dim OutApp As Object
    Dim i As Integer
    Dim AccNo As Integer
    Dim emailToSendTo As String
    
    Set OutApp = CreateObject("Outlook.Application")
    'emailToSendTo = "epsteel@gmail.com"                    'put required email address
    AccNo = 1
    '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
        If OutApp.Session.Accounts.Item(i).DisplayName = AcctToUSe Then

            AccNo = i
            Exit For
        End If
    Next i
    ListEMailAccounts = AccNo
    Set OutApp = Nothing
End Function

 

[Minty]

Wow that 's a bit of a while ago !

@Gasman - Note that I think your code is using early binding for the outlook objects, I think it should work with almost every version but might be worth checking.

 

[Gasman]

Minty,
Yes May 18 I think, however I could not get the Msdocs code to work from the link I originally posted?
Not my code, I just copied Rogers code as he posted it and then replaced the index for the account with your function.

Edit: Ah I see, you meant my Sendmail code.

Yes I use early binding, just because I am the only one who uses it and to be able to take advantage of the Intellisense.

I need all the help I can get.

 

[ed coleman]

Sub Test2()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim iAccountIndex As Integer

iAccountIndex = ListEMailAccounts("Gmail")

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail ' This creates a blank email and captures the users default signature.
.BodyFormat = 2 '2 'olFormatHTML
.Display
End With

With OutMail
.To = "rogercoop@aol.com"
.CC = ""
.BCC = ""
.Subject = "test 2"
.SendUsingAccount = OutApp.Session.Accounts.Item(iAccountIndex)
'.From 2
'.Attachments.Add (VarAttachFile)
'.HTMLBody = "test"
.Send
'.ReadReceiptRequested = False
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Public Function ListEMailAccounts(AcctToUSe As String) As Integer
Dim OutApp As Object
Dim i As Integer
Dim AccNo As Integer
Dim emailToSendTo As String

Set OutApp = CreateObject("Outlook.Application")
'emailToSendTo = "epsteel@gmail.com" 'put required email address
AccNo = 1
'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
If OutApp.Session.Accounts.Item(i).DisplayName = AcctToUSe Then

AccNo = i
Exit For
End If
Next i
ListEMailAccounts = AccNo
Set OutApp = Nothing
End Function

Not sure what you mean on the bolded line in the function above for email to send to. I'm not having a problem with the .to email address, but the From email address.

If the report shows "coleman" in a hidden text box then the email should be sent from ebroomhead@colemancontainers.com. If the report shows Boxes Next Day for that customer, then the email should be sent from ebroomhead@boxesnextday.com.

Thanks for you help so far.


Ed

 

[Gasman]

Minty's function was originally using the email address to identify the correct account even though AcctToUSe was the parameter that needed to be passed.

I preferred to use the account name, as if I was implementing this in work, the account names would be the same for each user, but not the email addresses.?

So you will see that test is commented out and I check DisplayName instead.

I've left everything as is, just commented out, so you can see what was there.
See the link for unaltered function.

The key line is

.SendUsingAccount = OutApp.Session.Accounts.Item(iAccountIndex)

after identifying the correct account via iAccountIndex.

 

[ed coleman]

Thanks again Gasman but cannot figure out where/how to set up the "From" company on your email code.

I have a skinnied database which I'll attach which may assist you in assisting me.

On the detailed AR report, I show user name from logon info and the company, coleman or boxes next day from the company that the customer is related to.



Merci.
Ed

 

[Gasman]

You need to decide which account to use depending on that report control.

However you have way more problems than that.
You did not have any Option Explicit at the top of each module. When I inserted it, and tried to compile it showed a host of missing variables.

Place Option Explicit at the top of each module after Option Compare Database and then Debug/Compile until it does not complain about anything.

As for your code

Dim iAccountIndex as Integer
.
.
.

If Reports!rpt_os_ar_by_cust_except!Text87 = "Boxes Next Day" Then
strAccount = "Boxes" ' Or whatever the boxes.com account is called
Else
strAccount = "Containers" ' Or whatever the colemancontainers.com account is called
End If

' Then get the index for the account

iAccountIndex = ListEMailAccounts(strAccount)

'Then to use the account

With oMail
.
.
	.SendUsingAccount = OutApp.Session.Accounts.Item(iAccountIndex)
.
.
End With

Take a tip from me. Name your controls to meaningful names Text87 or Text113 is not going to mean anything to you one week from now.

HTH

 

[ed coleman]

Thanks again for your input, but I am thinking that the problems you encountered when trying to compile is the fact that i have skinnied it down. The source tables are all from a ODB connection and I got rid of all of them for confidentiality. What I sent does work on my system, giving an email with any wording that I had input. The problem remains that it does not automatically assign the From address based on the text box, text87, on my report.


Regards,
Ed

 

[ed coleman]

Made the changes that you noted above and ran the report based on a "BoxesNextDay" Customer and From address is still showing @colemancontainers.com.


Here is my current code:


Me.Refresh
Dim iAccountIndex As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strReportName As String
Dim strmessagebody As String
Dim strto As String
Dim appOut As Outlook.Application
Dim oAccount As Outlook.Account
Dim strAccount As String
Dim oMail As Outlook.MailItem 'ADDED 4/11/2019

Set appOut = New Outlook.Application
Set oMail = appOut.CreateItem(olMailItem) 'ADDED 4/11/2019
If Reports!rpt_os_ar_by_cust_except!Text87 = "Boxes Next Day" Then
strAccount = Reports!rpt_os_ar_by_cust_except!Text12 & "@boxesnextday.com" 'looks like joeblow@boxesnextday.com
Else
strAccount = Reports!rpt_os_ar_by_cust_except!Text12 & "@colemancontainers.com" 'looks like joeblow@colemancontainers.com
End If

Set oAccount = appOut.Session.Accounts(strAccount)

strReportName = "rpt_os_ar_by_cust_except"

strmessagebody = IIf(IsNull(Forms!frmselcommentsforemail!Text5), "", Forms!frmselcommentsforemail!Text5)
strto = Reports!rpt_os_ar_by_cust_except!Text124
'Debug.Print Reports!rpt_os_ar_by_cust_except!Text124
Me.Refresh
strBody = "<P STYLE='font-family:calibri;font-size:14.5px'/P>"
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, CurrentProject.Path & "" & strReportName & ".pdf", False
iAccountIndex = ListEMailAccounts(strAccount)
'******************************* USER DEFINED SECTION ********************************
strSubject = "Outstanding Invoices"
'*************************************************************************************

With oMail
'On Error Resume Next
.To = strto
.cc = Reports!rpt_os_ar_by_cust_except!Text126

.HTMLBody = strBody & "Attn:  " & Reports!rpt_os_ar_by_cust_except.Text122 & "," & (Chr(13) + Chr(10)) & (Chr(13) + Chr(10)) & "<br>" & "<br>" & strmessagebody
.Subject = strSubject & " for " & Reports!rpt_os_ar_by_cust_except!CSNAME & " (This is a " & Reports!rpt_os_ar_by_cust_except!Text87 & " Company)"
.Attachments.Add CurrentProject.Path & "" & strReportName & ".pdf"
.SendUsingAccount = appOut.Session.Accounts.Item(iAccountIndex)
.Display 'VIEW email before sending
'.Send 'Immediately Sends the E-Mail without displaying Outlook
End With

Set oAccount = Nothing
Set appOut = Nothing

DoCmd.Close acReport, "rpt_os_ar_by_cust_except"

DoCmd.Close acForm, "frmselcommentsforemail"
End Sub

 

[Gasman]

You are still using email address and NOT the name of the account for that address.

That is how my version of Minty's code works.? If you want to use his version, then amend that code and pass in the email address.
I would prefer account name, in case the email address changes, for instance another user gets this task.?

Also what is this for? I always comment out unnecessary code but leave it in place, just so I can see how I got to where I am. If not used after a while, I generally remove it.

Set oAccount = appOut.Session.Accounts(strAccount)

Inspect the objects and varaiables in the immediate window to see what is being produced.

 

[ed coleman]

Thanks Gasman for all your assistance.

I don't think I have the knowledge to implement your code and make it work for me. We'll manually change the From address when we send the email.

Again, thanks for your help.