VBA Send Email to Customers when payment is DUE including Receipt ID

[christinachahin]

My Excel Worksheet contains the following:
Column A-------------- Column B -------------- Column C --------------------- Column D ------------------------------ Column E
Customer Name ------ Due Date Payment ---- Send Email (# Days) ---------Customer Email Address -------------- TransactionID


The following application sends this email message to all the customer email addresses on the sheet:
+++++++++++++++++++++++++++++++++++++++++++++

Dear Customer,
We would like to remind you that your payment for the following transaction 13879;13904;13957;400000052;<wbr>13748;13778;13779;13780;13782;<wbr>13796;13953;13682;13692;13697;<wbr>13721;13743;13759;13781;13783;<wbr>13790;400000049 is due soon.
Please ignore if already paid.
Thank you,

++++++++++++++++++++++++++++++++++++


The application reads prints out the same message to all of the different customers and includes all of the transaction IDs that are due soon. However, I would like the application to send out a personalized email to each individual customer that contains only their own Transaction ID for payment.

Please Help!!


Sub SendReminderMail()
Dim OutlookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String
Dim iCounter2 As Integer
Dim TransactionID As String

Set OutlookApp = CreateObject("Outlook.<wbr style="font-family: arial, sans-serif; font-size: 12.8px;">application")
Set OutLookMailItem = OutlookApp.CreateItem(0)

With OutLookMailItem
MailDest = ""
For iCounter = 1 To WorksheetFunction.CountA(<wbr style="font-family: arial, sans-serif; font-size: 12.8px;">Columns(4))
If MailDest = "" And Cells(iCounter, 4).Offset(0, -1) = "Send Email (1-15 Days)" Then
MailDest = Cells(iCounter, 4).Value
ElseIf MailDest <> "" And Cells(iCounter, 4).Offset(0, -1) = "Send Email (1-15 Days)" Then
MailDest = MailDest & ";" & Cells(iCounter, 4).Value
End If
Next iCounter

TransactionID = ""
For iCounter2 = 1 To WorksheetFunction.CountA(<wbr style="font-family: arial, sans-serif; font-size: 12.8px;">Columns(5))
If TransactionID = "" And Cells(iCounter2, 4).Offset(0, -1) = "Send Email (1-15 Days)" Then
TransactionID = Cells(iCounter2, 5).Value
ElseIf TransactionID <> "" And Cells(iCounter2, 4).Offset(0, -1) = "Send Email (1-15 Days)" Then
TransactionID = TransactionID & ";" & Cells(iCounter2, 5).Value
End If
Next

.BCC = MailDest
.Subject = "Payment Due"
.HTMLBody = "
" & "
" & "Estimado Cliente, Le queríamos recordar que su factura " & TransactionID & " vence
pronto. Please ignore if already paid.
Gracias por preferirnos,

Departamento De Cobros"
.Send
End With

Set OutLookMailItem = Nothing
Set OutlookApp = Nothing
End Sub



------------------------------------------------Command Button-----------------------------------------------

Private Sub CommandButton1_Click()
For Each cell In Range("B2:B1000")
n = Now()
If Year(cell.Value) = Year And Month(cell.Value) = Month And
Day(cell.Value) <= 15 Then
cell.Interior.ColorIndex = 5
cell.Font.ColorIndex = 2
cell.Font.Bold = True
End If
Next

SendReminderMail
End Sub

 

[pbornemeier]

Welcome to the Board!

This should get you closer - I did not test fully. Test and get it right to your satisfaction before changing .Display to .Send

Option Explicit

Sub SendReminderMail()

    Dim OutlookApp As Object
    Dim OutLookMailItem As Object
    Dim lCounter As Integer
    Dim sTransactionID As String
    Dim sName As String
    Dim sEmailAddr As String
    Dim sDate As String
    
    Set OutlookApp = CreateObject("Outlook.application")
    
    'Generate Individual Emails
    For lCounter = 2 To Cells(Rows.Count, 1).End(xlUp).Row  '2 if header, 1 if data starts in row 1
        If Cells(lCounter, 3).Value = "Send Email (1-15 Days)" Then
        
            Set OutLookMailItem = OutlookApp.CreateItem(0)
            With OutLookMailItem
                sName = Cells(lCounter, 1).Value
                sDate = Format(Cells(lCounter, 2).Value, "mm/dd/yyyy")
                sEmailAddr = Cells(lCounter, 4).Value
                sTransactionID = Cells(lCounter, 5).Value
                
                .To = sEmailAddr
                .Subject = "Payment Due"
                .Body = "Dear " & sName & "," & Chr(10) & Chr(13) & _
                    "We would like to remind you that your payment for transaction: " & sTransactionID & " is due by " & sDate & "." & Chr(10) & Chr(13) & _
                    "Please ignore if already paid."
            
                .Display   'for testing
                '.Send      'to actually send email
            End With
        End If
        Set OutLookMailItem = Nothing
    Next
    
    Set OutlookApp = Nothing
End Sub