Attach Excel Files to Outlook Emails from Access

I am trying to attach an external Excel files to emails from a folder using the following code.  The file name is in an Access table. For each email there is a related Excel file with the name of file equal to the tblTempShipNotice.Adjudicator. The email address is in the same table.


 
  Dim sMail                 As String
    Dim objOutlook            As Object
    Dim rs                    As DAO.Recordset
    Dim sSQL                  As String
    Dim strName               As String
    Dim sSubj                 As String
    Dim sBody                 As String
    Dim sTo                   As String
    Dim strCC                 As String
    Dim sCC                   As String

    'Get Email Addres
'    sSQL = "SELECT tblTempShipNotice.Email, tblTempShipNotice.Lname FROM tblTempShipNotice;"
    sSQL = "SELECT tblTempShipNotice.Email, tblTempShipNotice.Lname, Concatenate(""SELECT Emails FROM tblFO WHERE FO='"" & Nz([FO],""~999"") & ""';"","";"") AS CCEmails " & vbCrLf & _
           "FROM tblTempShipNotice;"

    Set rs = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
    With rs
        If .RecordCount <> 0 Then
            Set objOutlook = CreateObject("Outlook.Application")
            Do While Not .EOF
                'Initialize the variable for each loop
                strName = ""
                sMail = ""
                sSubj = ""
                'Populate the variables with our record data
                strName = Nz(rs![Lname], "")
                sMail = sMail & ";" & Nz(rs("Email"), "")
                strCC = Nz(rs![CCEmails], "")
                If strCC <> "" Then strCC = strCC & ";"
                Call Outlook_SendEmail(objOutlook, sMail, strCC, sCC, sSubj)

                .MoveNext
            Loop
            Set objOutlook = Nothing
        End If
    End With
End Sub

Function Outlook_SendEmail(ByVal objOutlook As Object, _
                           ByVal sMail As String, _
                           ByVal strCC As String, _
                           ByVal sCC As String, _
                           ByVal sSubj As String)
    Dim objEmailMessage       As Object

    Set objEmailMessage = objOutlook.CreateItem(0)
    With objEmailMessage
        .To = sMail
        If strCC & "" <> "" Then
            .cc = sCC
        End If
        .cc = strCC
        .Subject = sSubj
        .SentOnBehalfOfName = "OSOMHAHQSerialClaims@hhs.gov"
        'Set body format to HTML
        .BodyFormat = olFormatHTML
        .Subject = "Serial Claims Initiative - All Claims Approved for Payment by CMS in Appeal(s) Assigned to You - - [Serial Claims Spreadsheet #[Numbering -based on the number of CMS Identified Spreadsheet]"
        sBody = "As part of the Serial Claims Initiative (SCI), CMS has indicated its intent to pay all of the related claims in an appeal(s) currently assigned to you. The Medicare Appeals Contractor has identified existing claims for coverage of the same durable medical equipment, for the same beneficiary, in identical or near-identical circumstances. A notification from the Medicare Appeals Contractor has been included for your information. " & _
                "<br><br>Please find attached a template for a fully favorable stipulated decision which you may wish to use for this appeal.  Though all claims must be, and continue to be, adjudicated separately by OMHA, you may wish to utilize this template to promote consistency among decisions across the agency. <br><br>Thank you for your consideration and if you have questions, please do not hesitate to contact me. <br><br>" & sBody & "</table><br><b><i><br>Thank you,<br><br>LLLL R. Mel<br>Branch Chief, Special Initiatives Branch " & _
                "<br>Field Operations Division<br>Department Services<br>XXX Davis Highway, Suite 2001<br>Mrto, VA  22222<br>Phone: (999) 777-7799<br><br></i></div></body></html>"
        .HTMLBody = sBody
        .Display
    End With
    Set objEmailMessage = Nothing
End Function

Public Function GetCCadresses(ByVal mail As String) As String
    Dim sql As String
    sql = vbNullString
    sql = sql & "SELECT tblFO.Emails  AS cc" & vbCrLf
    sql = sql & "FROM tblFO INNER JOIN tblTempShipNotice" & vbCrLf
    sql = sql & "ON tblFO.FO = tblTempShipNotice.FO" & vbCrLf
    sql = sql & "WHERE tblTempShipNotice.Email = """ & mail & """;"

    Dim db As DAO.Database
    Set db = CurrentDb

    Dim rs As DAO.Recordset
    Set rs = db.OpenRecordset(sql, dbOpenSnapshot)

    Dim cc As String
    While Not rs.EOF
        cc = cc & rs("cc") & ";"    '// adjust to fit your needs
        rs.MoveNext
    Wend
    rs.Close
    GetCCadresses = cc
End Function

Open in new window

shieldscoAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Daniel PineaultPresident / Owner CARDA Consultants Inc.Commented:
Inspire yourself of the function found at http://www.devhut.net/2010/09/03/vba-send-html-emails-using-outlook-automation/ to include attachments in your outlook automation,
Fabrice LambertConsultingCommented:
For each email there is a related Excel file with the name of file equal to the tblTempShipNotice.Adjudicator.
Do you mean the file name will be Something like: Karen Smit.xlsx ?

But where are the files stored exactly ? The full path of the file is needed to add an attachment.
Fabrice LambertConsultingCommented:
Side notes about the sample database you provided in your earlyer post:

Tables arn't normalized (no primary key, no foreign key),  there are no Relationship between your tables, and no referential integrity.
I suggest you document yourself about databases design, this will help your for futur use.
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

shieldscoAuthor Commented:
The actual db has primary keys
shieldscoAuthor Commented:
Yes the file name would be in the form of Karen Smit.xlsx and the files are located on a network drive.... U:\QIC Demo Notices DB\Exports
Fabrice LambertConsultingCommented:
Still, we Don't know where the files to be attached are.

In my otinion, it will be better to add a column in your tblTempShipNotice table, with the full path of files.
This way you won't mix several infos into one. Someone's name is not a file name, neither a file path.
shieldscoAuthor Commented:
the tblTemShipNotice table has the file name excluding xlsx in a field named Adjudicator
Fabrice LambertConsultingCommented:
Yeah, but no path.

And building the path from an hard-coded string isn't a good idea, as that will mean if for whataver reasons, the file are moved somewhere else, the code must be updated, and the application deployed again.
While if the path are written in a table, only the table need to be updated.

Also, with networks, it is better to provide a UNC path, as Nothing can ensure you that the drive letter will be the same on another computer.
shieldscoAuthor Commented:
I would change the hard code path with CurrentProject.Path & "\Exports\" so I can move the DB to any location without changing code
Fabrice LambertConsultingCommented:
Below is the updated code:
Option Compare Database
Option Explicit

Private Sub Command0_Click()
    Dim sMail                 As String
    Dim objOutlook            As Object
    Dim rs                    As DAO.Recordset
    Dim sSQL                  As String
    Dim strName               As String
    Dim sSubj                 As String
    Dim sBody                 As String
    Dim sTo                   As String
    Dim strCC                 As String
    Dim sCC                   As String

    'Get Email Addres
'    sSQL = "SELECT tblTempShipNotice.Email, tblTempShipNotice.Lname FROM tblTempShipNotice;"
	sSQL = vbNullString
	sSQL = sSQL & "SELECT 	tblTempShipNotice.Email," & vbCrLf
	sSQL = sSQL & "			tblTempShipNotice.Lname," & vbCrlf
	sSQL = sSQL & "			Concatenate(""SELECT Emails FROM tblFO WHERE FO='"" & Nz([FO],""~999"") & ""';"","";"") AS CCEmails," & vbCrlf
	sSQL = sSQL & "			tblTempShipNotice.Adjudicator" & vbCrLf 
    sSQL = sSQL & "FROM	tblTempShipNotice;"

    Set rs = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
    With rs
        If .RecordCount <> 0 Then
            Set objOutlook = CreateObject("Outlook.Application")
            Do While Not .EOF
                'Initialize the variable for each loop
                strName = ""
                sMail = ""
                sSubj = ""
                'Populate the variables with our record data
                strName = Nz(rs![Lname], "")
                sMail = sMail & ";" & Nz(rs("Email"), "")
                strCC = Nz(rs![CCEmails], "")
                If strCC <> "" Then strCC = strCC & ";"
				
				dim filePath As String
				filePath = vbNullString
				If (rs("Adjudicator") & vbNullString <> vbNullString) Then
					filePath = CurrentProject.Path & "\Exports\" & rs("Adjudicator") & ".xlsx"
				End If
                Call Outlook_SendEmail(objOutlook, sMail, strCC, sCC, sSubj, filePath)

                .MoveNext
            Loop
            Set objOutlook = Nothing
        End If
    End With
End Sub

Function Outlook_SendEmail(ByVal objOutlook As Object, _
                           ByVal sMail As String, _
                           ByVal strCC As String, _
                           ByVal sCC As String, _
                           ByVal sSubj As String, _
						   Optional ByVal filePath As String = vbNullString)
    Dim objEmailMessage       As Object

    Set objEmailMessage = objOutlook.CreateItem(0)
    With objEmailMessage
        .To = sMail
        If strCC & vbNullString <> vbNullString Then
            .cc = strCC
        End If
        .cc = strCC
        .Subject = sSubj
        .SentOnBehalfOfName = "OSOMHAHQSerialClaims@hhs.gov"
        'Set body format to HTML
        .BodyFormat = olFormatHTML
        .Subject = "Serial Claims Initiative - All Claims Approved for Payment by CMS in Appeal(s) Assigned to You - - [Serial Claims Spreadsheet #[Numbering -based on the number of CMS Identified Spreadsheet]"
        sBody = "As part of the Serial Claims Initiative (SCI), CMS has indicated its intent to pay all of the related claims in an appeal(s) currently assigned to you. The Medicare Appeals Contractor has identified existing claims for coverage of the same durable medical equipment, for the same beneficiary, in identical or near-identical circumstances. A notification from the Medicare Appeals Contractor has been included for your information. " & _
                "<br><br>Please find attached a template for a fully favorable stipulated decision which you may wish to use for this appeal.  Though all claims must be, and continue to be, adjudicated separately by OMHA, you may wish to utilize this template to promote consistency among decisions across the agency. <br><br>Thank you for your consideration and if you have questions, please do not hesitate to contact me. <br><br>" & sBody & "</table><br><b><i><br>Thank you,<br><br>LLLL R. Mel<br>Branch Chief, Special Initiatives Branch " & _
                "<br>Field Operations Division<br>Department Services<br>XXX Davis Highway, Suite 2001<br>Mrto, VA  22222<br>Phone: (999) 777-7799<br><br></i></div></body></html>"
        .HTMLBody = sBody
		If(filepath <> vbNullString) Then
			.Attachments.Add filePath
		End If
        .Display
    End With
    Set objEmailMessage = Nothing
End Function

Open in new window

Note: I also Added the "Option Explicit" option, it will raise an error if you attempt o use an undeclared variable, and prevent the issue you had earlyer.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
shieldscoAuthor Commented:
Works great.. thanks for all your help... I think I got the points right this time.
Daniel PineaultPresident / Owner CARDA Consultants Inc.Commented:
Just as a side note, you don't need the GetCCadresses() function as the solution uses Duane Hookom's Concatenate() Function instead.  So to cleanup your code would might wish to delete it so when you are reviewing your code in a few months/years you are confused.
shieldscoAuthor Commented:
Thanks... I did
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.