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
From novice to tech pro — start learning today.