Sending email from Access query result VBA Outlok to different group of customers (1 Viewer)

Option Compare Database
Public Function data_definition()
Dim CurrentDB As DAO.Database
Set CurrentDB = DBEngine(0)(0)
'Dim rstReseller As Recordset
Dim rstEC As Recordset
Dim rstMail As Recordset
Dim rstAgent As Recordset
Dim StrOutPutFile As String

End Function


Public Function Send_Emails()
'============================NECCESARY FOR OUTLOOK CODE============================
Dim MyBody As TextStream
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim MySQLVariable
Dim rstBranch
Dim BranchList
Dim BranchName
Dim fso As FileSystemObject
Set fso = New FileSystemObject
'============================FINISH============================


'============================TESR DATA============================
BranchList = "Select distinct Backlog.Alias from Backlog where (Backlog.[Alias] is not null)"

Set rstBranch = CurrentDB.OpenRecordset(BranchList)


Do While rstBranch.EOF = False


BranchName = rstBranch![Alias]

MySQLVariable = "SELECT Backlog.Alias AS [Cliente], Backlog.SalesOrderNumber AS [Num Orden], Backlog.ShipSetNo AS [Num ShipSet], Backlog.LineNumber AS [Num Linea], " _
& "Backlog.OriginSLCName AS [Pais de Origen]," _
& "Backlog.DestinationSLCName AS [Lugar de Embarque]" _
& "From Backlog " _
& "WHERE (((Backlog.[Alias]) = " & "'" & BranchName & "'" & ")) " _
& "Group By Backlog.Alias, Backlog.SalesOrderNumber, Backlog.ShipSetNo, Backlog.LineNumber, Backlog.OriginSLCName, Backlog.DestinationSLCName " _
& "ORDER BY Backlog.[Alias], Backlog.SalesOrderNumber" _
& "HAVING (((Backlog.EmailDate) Is Null))"


On Error Resume Next

CurrentDB.QueryDefs.Delete "Email_Table"

Set qrydef = CurrentDB.CreateQueryDef("Email_Table", MySQLVariable)

StrOutPutFile = "C:\Backlog\" & Alias & ".html"
DoCmd.TransferText acExportHTML, , "Email_Table", StrOutPutFile, True



'============================FINISH============================

'============================SAVE EMAIL DRAFT============================

'OPEN BODY FILE
Set MyBody = fspenTextFile(StrOutPutFile, ForReading, False, TristateUseDefault)
'PUT html FILE IN VARIABLE
TableText = MyBody.ReadAll
'CLOSE FILE
MyBody.Close

Set MyOutlook = Outlook.Application

'============================BDM TA and User Information for Assignment============================
MailList = "SELECT Contacts.Alias, Contacts.email " _
& "From Contacts " _
& "WHERE (((Contacts.Alias)= " & "'" & BranchName & "'" & ")) "
Set rstMail = CurrentDB.OpenRecordset(MailList)

'ADD HEADER 1
Header1Text = "<p> " & " <font size=3 face='Verdana'> " & "Estimado Cliente: " & rstMail![BranchList] & " </font> " & "<BR> <BR> <BR>" & "</p>" & "<p> " & "<BR> <BR> <BR>" & " <font size=2 face='Verdana'> " & "La tabla adjunta muestra las ultimas ordenes liberadas." & " </font> " & "<BR> <BR> <BR>" & "</p>"


'OPEN HEADER2 FILE
EP1Text = "<p> " & " <font size=2 face='Verdana'> " & "La tabla adjunta muestra las ultimas ordenes liberadas." & " </font> " & "<BR> <BR> <BR>" & "</p>"



Set MyBody = fspenTextFile("C:\Backlog\template\BranchName.htm", ForReading, False, TristateUseDefault)
Header2Text = MyBody.ReadAll
MyBody.Close


'============================FINISH============================
Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.To = Tomails
'MyMail.ReplyRecipients.Add rstMail![BDM Email]
'MyMail.ReplyRecipients.Add rstMail![TA Email]
'MyMail.SentOnBehalfOfName = "renewals-alert@cisco.com"
MyMail.HTMLBody = Header1Text & Header2Text & TableText & EP1Text & EP2Text & "Cisco Systems Inc. Argentina"
MyMail.Subject = "Estimado cliente " & BranchName & " " & "adjuntamos nuevas ordenes liberadas"
MyMail.Save
MyMail.Close olPromtForSave
'============================FINISH============================
rstBranch.MoveNext
Loop
End Function

Click to expand...