Use If through fields

[Sako]

Hi everyone,

I am so closed to what I want to do but I am stuck on some VBA loop. This table is not normalized because it is an excel file that I receive every week. So I'd rather just copy that file into the same folder every week instead of having to normalize again. Since this is built for a user, I also want it to make it as user friendly as possible,

I have a table with : Email, Course1, Course2, Course3, Course4 as fields.

I want to send an email to each of them who's Course1 to Course 4 are not "Passed" with the name of the course (Course1,2,3,4)

I have the email part setup perfectly, but I need some help with the recordset.

As an example, the output I need is this:

"Hi,


You have not completed the courses below

Course1
Course2
Course4"

attached is a sample... I have a feeling im only missing one or two lines of code...

Thanks

 

[thechazm]

Here is the code that will do exactly as you stated.

Option Compare Database
Option Explicit
Function SendEmail()
Dim rst2 As DAO.Recordset, db As Database
Dim strNewsletters As String
' New variables added
Dim i As Long, sEmailArray(10) As String, bSendEmail As Boolean
Dim strTemplate As String, lngCount As Long
' Setup for outlook
Dim appOutlook As Outlook.Application, Msg As Outlook.MailItem
Set db = CurrentDb
Set appOutlook = GetObject(, "Outlook.Application")
Set rst2 = db.OpenRecordset("Table1", dbOpenSnapshot)
i = 3
Do While rst2.EOF = False
    Do While i < rst2.Fields.Count
        With rst2
            If .Fields(i).Value <> "Passed" Then
                bSendEmail = True ' Send email yes or no
                sEmailArray(i) = .Fields(i).Name ' Build Array with items
            End If
        End With
        i = i + 1
    Loop
    i = 3
    
    If bSendEmail = True Then
        Set Msg = appOutlook.CreateItem(olMailItem)
        With Msg
            .Subject = "Uncompleted Clix Courses"
            .To = rst2![Email]
            .body = "Hi," & vbNewLine & vbNewLine & "You have not completed the following courses below" & vbNewLine & vbNewLine
            For lngCount = LBound(sEmailArray) To UBound(sEmailArray) ' Counts through the array checking for the value's needed to be added to email.
                If sEmailArray(lngCount) <> "" Then
                    strNewsletters = strNewsletters & UCase(sEmailArray(lngCount)) & vbNewLine
                End If
            Next lngCount
            .body = .body & strNewsletters
            .Send
        End With
    End If
    
    
    strNewsletters = ""
    bSendEmail = False
    Erase sEmailArray
    rst2.MoveNext
Loop
rst2.Close
Set rst2 = Nothing
End Function