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.Adjudica
tor. 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 & _
Set rs = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
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)
Set objOutlook = Nothing
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)
.To = sMail
If strCC & "" <> "" Then
.cc = sCC
.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
Set objEmailMessage = Nothing
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
GetCCadresses = cc