Hi - I found a post from @June7 assisting another member here and my issue is quite similar, so hopefully not much mofidication is in order. I am in need of creating an email draft for each row in my recordset. So if the recordset returns 3 then I need 3 drafts created.
This is the code I tweaked from @June7 but I'm only getting a draft created and saved for my last row in the recordset...
This is the code I tweaked from @June7 but I'm only getting a draft created and saved for my last row in the recordset...
Code:
Option Compare Database
Option Explicit
Function CreateEmail()
Dim currentMonth As String
'adding 1 since our test data is for July
currentMonth = MonthName(Month(Now) + 1, True)
CreateEmailTemplate "SELECT CustomerInformation.CompanyName, CustomerInformation.CompanyContactName, CustomerInformation.TP, FolderInformation.LocalFolder FROM CustomerInformation INNER JOIN FolderInformation ON CustomerInformation.CompanyName = FolderInformation.CompanyName WHERE Mid(SS, InStrRev(SS, ' ') + 1) = '" & currentMonth & "'"
End Function
Private Sub CreateEmailTemplate(recSet As String)
Dim contact As String
Dim emailBody As String: emailBody = "This is a test email body"
Dim emailSubject As String: emailSubject = "Test Subject"
Dim customer As String
Dim appOutlook As Outlook.Application
Dim MailOutlook As Outlook.MailItem
Dim rs As DAO.Recordset
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutlook = appOutlook.CreateItem(olMailItem)
Set rs = CurrentDb.OpenRecordset(recSet)
Do While Not rs.EOF
contact = rs!CompanyContactName
Debug.Print contact
With MailOutlook
.BodyFormat = olFormatHTML
.To = "abcdefg@gmail.com"
.Subject = emailSubject
.HTMLBody = "Hi " & contact & ","
.Save
.Close olSave
End With
rs.MoveNext
Loop
End Sub
