Email Detailed Report by Looping Through Related tables

[cavscout]

I want to automate the distribution of individuals Vacation Balance and Usage via email. The data is being pulled from 2 tables related by an Employee ID#. tbl-Employees provides the Header Info for each employee and tbl-VacLog provides the detailed Usage data.

I want the output to appear as follows in the body of the email:

Name Start Date Vac. Bal TotVacToEOY Personal Bal.
John Doe 1/1/99 120 160 8

Usage Date Hours Reason Code
1/1/13 8 V
2/15/13 12 V
3/6/13 8 V


I've got a handle on creating the email and sending but where I'm having trouble is in making the link between the two tables with the Employee ID# and printing the corresponding detail data with Parent Record. Any guidance or better option appreciated. Code below...

Option Compare Database

Sub SendMails()
Dim DB As Database
Dim RecordSetA As DAO.Recordset
Dim RecordSetB As DAO.Recordset
Dim TotalRecordsA As Integer
Dim TotalRecordsB As Integer
Dim CurrentRecordA As Integer
Dim CurrentRecordB As Integer
Dim EmailBody As String
Dim BEmpID As String
Dim AFileNum As String


Set DB = CurrentDb
Set RecordSetA = DB.OpenRecordset("tbl-Employees", dbOpenDynaset)
Set RecordSetB = DB.OpenRecordset("Tbl - VacLog", dbOpenDynaset)
    
    RecordSetA.MoveLast
    TotalRecordsA = RecordSetA.RecordCount
    RecordSetA.MoveFirst

    RecordSetB.MoveLast 
    TotalRecordsB = RecordSetB.RecordCount
    RecordSetB.MoveFirst
    
    AFileNum = ""
    BEmpID = ""
    
    For CurrentRecordA = 1 To TotalRecordsA
    EmailBody = ""
    AFileNum = RecordSetA.Fields("File#")
    BEmpID = RecordSetB.Fields("EmpID")
    
            
                
                Do While AFileNum = BEmpID
                    For CurrentRecordB = 1 To TotalRecordsB
                        If AFileNum <> BEmpID Then Exit Do
                        'RecordSetB.FindFirst "[EmpID] =" & RecordSetA.Fields("FILE#")
                        EmailBody = EmailBody & vbCr & RecordSetB.Fields("UsageDate") & "   " & RecordSetB.Fields("Hours") & "   " & RecordSetB.Fields("ReasonCode")
                    RecordSetB.MoveNext
                    Next CurrentRecordB
                Loop
            
       
            
        Call SendEmails(RecordSetA.Fields("EmailAddress"), RecordSetA.Fields("NAME"), RecordSetA.Fields("ServiceRefDate"), RecordSetA.Fields("VacBalance"), RecordSetA.Fields("TotalVacationToEndOfYear"), RecordSetA.Fields("PersonalBalance"), RecordSetA.Fields("FreeDayBalance"), RecordSetA.Fields("DiscretionaryDayBalance"), RecordSetA.Fields("TotalPossible"), EmailBody) 'RecordSetB.Fields("UsageDate"), RecordSetB.Fields("Hours"), RecordSetB.Fields("ReasonCode")) ', RecordSetB.Fields("Notes"))
                
    RecordSetA.MoveNext
    Next CurrentRecordA

    'RecordSetA.MoveNext
    'Next CurrentRecordA

RecordSetA.Close
RecordSetB.Close

Set RecordSetA = Nothing
Set RecordSetB = Nothing
Set DB = Nothing
End Sub

Sub SendEmails(Recipient As String, Employee As String, StartDate As Date, VacationBalance As Integer, TotVacToEOY As Integer, PersonalBal As Integer, FreeBal As Integer, DiscretionaryBal As Integer, PossibleAccrual As Integer, DetailReport As String) 'DateUsed As Date, HoursTaken As Integer, Code As String) ', Comments As String)
Dim myOlApp As Outlook.Application
Dim Refmail As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
Set Refmail = myOlApp.CreateItem(olMailItem)
With Refmail
.To = Recipient
.Display
.Body = Employee & "  " & StartDate & "  " & VacationBalance & "  " & TotVacToEOY & "  " & PersonalBal & "  " & FreeBal & "  " & DiscretionaryBal & "  " & PossibleAccrual & "  " & _
vbCr & DetailReport
.Subject = "Your Vacation Usage and Status"
.Send
End With

Set myOlApp = Nothing
Set Refmail = Nothing
End Sub

 

[nathansav]

Use a SQL Join