How can I use a recordset in a report?

I need to generate a report based on many tables. I was hoping the code I used to send the same information via email could be used to generate a report. I have attached my email code.  Does any one have any ideas?

Sub Emailemployees()
Dim objOL As New Outlook.Application
Dim objOLMail As Outlook.MailItem
Dim db As Database
Dim rcd As Recordset
Dim Empname As String
Dim empemail As String
Dim SQLEmpEmail As String
Dim SQLSubjectLine As String
Dim SQLCase As String
Dim strsubjectLine As String
Dim SQLLeadEmpEmail As String
Dim strToLeadEmail As String
Dim strToEmail As String
Dim strBodyCase As String
Dim strBodyUpdate As String
Dim strBodyActivity As String
Dim strpath As String
Dim SQLAddress As String
Dim strBodyAddress As String
Dim AddressBreak As String
Dim SQLEmailAddress As String
DoCmd.Hourglass True
Set db = Currentdb()
'Build Subject Line
SQLSubjectLine = "SELECT 'Case Information ' & [subjectlast] & ', ' & [subjectfirst] & ' ' AS SubjectName, tblsubjects.casenumber FROM tblsubjects where subjectid = " & Me.subjectid

Set rcd = db.OpenRecordset(SQLSubjectLine, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
      .MoveFirst
      Do Until rcd.EOF
            strsubjectLine = strsubjectLine & .Fields(0) & .Fields(1)
            .MoveNext
            Loop
      End If
End With
'Build Lead Employee Email
SQLLeadEmpEmail = "SELECT tblemployees.employeeid, '(' & [firstname] & ' ' & [lastname] & ') ' AS LeadName, tblemployees.emailaddress FROM tblemployees INNER JOIN tblsubjects ON tblemployees.employeeid = tblsubjects.employeeid where subjectid = " & Me.subjectid


Set rcd = db.OpenRecordset(SQLLeadEmpEmail, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
      .MoveFirst
      Do Until rcd.EOF
            strToLeadEmail = strToLeadEmail & .Fields(1) & .Fields(2) & ";"
            .MoveNext
            Loop
      End If
End With
'Build Additional Employee Email List
SQLEmpEmail = "SELECT tblLKEmployee.EmployeeID, '(' & [Firstname] & ' ' & [lastname] & ') ' , tblemployees.emailaddress FROM tblemployees INNER JOIN tblLKEmployee ON tblemployees.employeeid = tblLKEmployee.EmployeeID where subjectid = " & Me.subjectid

Set rcd = db.OpenRecordset(SQLEmpEmail, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
      .MoveFirst
      Do Until rcd.EOF
            strToEmail = strToEmail & .Fields(1) & .Fields(2) & ";"
            .MoveNext
            Loop
      End If
End With
'Case Subject Information
CaseBreak = "CASE INFORMATION SECTION" & vbCrLf
SQLCase = "SELECT tblsubjects.dateassigned, tblsubjects.casenumber, tblsubjects.clientfilenumber," _
& "tblsubjects.othernum,tblsubjects.insuredname,tblsubjects.policynumber, tblsubjects.dol, tblsubjects.casetype," _
& "[subjectlast] & ', ' & [subjectfirst] AS SubjectName, [subjectaddress] & ', ' & [subjectcity] & ', ' & [subjectstate] & ' ' & [subjectzip] AS Subjectlocation, tblsubjects.homenumber," _
& "tblsubjects.othernumber, tblsubjects.subjectemail, tblsubjects.screenname, [SubjectDOB] & ' ' & 'Age ' & [age] AS SubjectAge, tblsubjects.subjectSSN, [race] & '/' & [sex] & ' ' & [subjectheight] & ' ' & [subjectweight] AS Description," _
& "tblsubjects.subjectmaritalst , tblsubjects.otherfeatures, tblsubjects.notesinternal, tblsubjects.notes FROM tblsubjects WHERE subjectID =" & Me.subjectid


Set rcd = db.OpenRecordset(SQLCase, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
      .MoveFirst
      Do Until rcd.EOF
            strBodyCase = strBodyCase & "Date Assigned: " & .Fields(0) & vbCrLf & "" _
            & "Case Number: " & .Fields(1) & vbCrLf & "File #: " & .Fields(2) & vbCrLf & "" _
            & "Case Name: " & .Fields(3) & vbCrLf & "Insured Name: " & .Fields(4) & vbCrLf & "Policy #: " & .Fields(5) & "" _
            & vbCrLf & "DOL: " & .Fields(6) & vbCrLf & "Case Type: " & .Fields(7) & vbCrLf & "Subject Name: " & .Fields(8) & vbCrLf & "" _
            & "Primary Address: " & .Fields(9) & vbCrLf & "Home #: " & .Fields(10) & vbCrLf & "Other #: " & .Fields(11) & vbCrLf & "Email: " & .Fields(12) & vbCrLf & "" _
            & "Screen Name: " & .Fields(13) & vbCrLf & "DOB/Age: " & .Fields(14) & vbCrLf & "SSN: " & .Fields(15) & vbCrLf & "Description: " & .Fields(16) & vbCrLf & "Status: " & .Fields(17) & vbCrLf & "" _
            & "Other Features: " & .Fields(18) & vbCrLf & "Notes: " & vbCrLf & .Fields(20) & vbCrLf & vbCrLf
            .MoveNext
            Loop
      End If
End With
'Query Address
AddressBreak = "CASE ADDITIONAL ADDRESSES SECTION" & vbCrLf
SQLAddress = "SELECT tbladditionaladdress.fromdate, tbladditionaladdress.todate, tbladditionaladdress.current, tbladditionaladdress.address, tbladditionaladdress.city, tbladditionaladdress.state, tbladditionaladdress.zip, tbladditionaladdress.notes FROM tbladditionaladdress WHERE subjectID =" & Me.subjectid & " ORDER BY [fromdate]"

Set rcd = db.OpenRecordset(SQLAddress, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
      .MoveFirst
      Do Until rcd.EOF
            strBodyAddress = strBodyAddress & "From Date: " & .Fields(0) & "-" & .Fields(1) & vbCrLf & "" _
            & "Current Address? " & .Fields(2) & vbCrLf & "" _
            & "Additional Address: " & " " & .Fields(3) & ", " & .Fields(4) & ", " & .Fields(5) & "  " & .Fields(6) & vbCrLf & "Notes: " & .Fields(7) & vbCrLf & vbCrLf
            .MoveNext
      Loop
      End If
End With
'Query Subject Email Address
EmailAddressBreak = "CASE ADDITIONAL EMAIL ADDRESSES SECTION" & vbCrLf
SQLEmailAddress = "SELECT tbleaddress.fromdate, tbleaddress.todate, tbleaddress.current, tbleaddress.emailaddress, tbleaddress.notes FROM tbleaddress WHERE subjectID =" & Me.subjectid & " ORDER BY [fromdate]"

Set rcd = db.OpenRecordset(SQLEmailAddress, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
      .MoveFirst
      Do Until rcd.EOF
            strBodyEmailAddress = strBodyEmailAddress & "From Date: " & .Fields(0) & "-" & .Fields(1) & vbCrLf & "" _
            & "Current Email? " & .Fields(2) & vbCrLf & "" _
            & "Email Address: " & " " & .Fields(3) & vbCrLf & "Notes: " & .Fields(4) & vbCrLf & vbCrLf
            .MoveNext
      Loop
      End If
End With
'Query Subject Web Address
WebAddressBreak = "CASE ADDITIONAL WEB ADDRESSES SECTION" & vbCrLf
SQLWebAddress = "SELECT tblwaddress.fromdate, tblwaddress.todate, tblwaddress.current, tblwaddress.webaddress, tblwaddress.notes FROM tblwaddress WHERE subjectID =" & Me.subjectid & " ORDER BY [fromdate]"

Set rcd = db.OpenRecordset(SQLWebAddress, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
      .MoveFirst
      Do Until rcd.EOF
            strBodyWebAddress = strBodyWebAddress & "From Date: " & .Fields(0) & "-" & .Fields(1) & vbCrLf & "" _
            & "Current Web Address? " & .Fields(2) & vbCrLf & "" _
            & "Web Address: " & " " & .Fields(3) & vbCrLf & "Notes: " & .Fields(4) & vbCrLf & vbCrLf
            .MoveNext
      Loop
      End If
End With
'Additional Subject Information
AddSubjectBreak = "CASE ADDITIONAL SUBJECT SECTION" & vbCrLf
SQLAddSubject = "SELECT tbladditionalsubject.adateentered, tbladditionalsubject.asubjecttype, [asubjectfirst] & ' ' & [asubjectlast] AS asubjectname, [asubjectaddress] & ', ' & [asubjectstate] & ' ' & [asubjectzip] AS asubjectlocation, tbladditionalsubject.ahomenumber, tbladditionalsubject.aothernumber, tbladditionalsubject.asubjectemail, tbladditionalsubject.ascreenname, [asubjectdob] & ' ' & 'Age ' & [aage] AS asubjectage, tbladditionalsubject.asubjectssn, [arace] & '/' & [asex] & ' ' & [asubjectheight] & ' ' & [asubjectweight] AS adescription, tbladditionalsubject.asubjectmaritalst, tbladditionalsubject.aotherfeatures, tbladditionalsubject.anotes FROM tbladditionalsubject WHERE subjectID =" & Me.subjectid


Set rcd = db.OpenRecordset(SQLAddSubject, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
      .MoveFirst
      Do Until rcd.EOF
            strBodyAddSubject = strBodyAddSubject & "Case Information:" & vbCrLf & "Date Entered: " & .Fields(0) & vbCrLf & "" _
            & "Type of Subject: " & .Fields(1) & vbCrLf & "Additional Subject Name: " & .Fields(2) & vbCrLf & "" _
            & "Primary Address: " & .Fields(3) & vbCrLf & "Home #: " & .Fields(4) & vbCrLf & "Other #: " & .Fields(5) & vbCrLf & "Email: " & .Fields(6) & vbCrLf & "" _
            & "Screen Name: " & .Fields(7) & vbCrLf & "DOB/Age: " & .Fields(8) & vbCrLf & "SSN: " & .Fields(9) & vbCrLf & "Description: " & .Fields(10) & vbCrLf & "Status: " & .Fields(11) & vbCrLf & "" _
            & "Other Features: " & .Fields(12) & vbCrLf & "Notes: " & vbCrLf & .Fields(13) & vbCrLf & vbCrLf
            .MoveNext
            Loop
      End If
End With
'Query Update
UpdateBreak = "CASE UPDATE SECTION" & vbCrLf
SQLUpdate = "SELECT tblupdatetable.date, tblupdatetable.caseupdate FROM tblupdatetable WHERE subjectID =" & Me.subjectid & " ORDER BY [date]"

Set rcd = db.OpenRecordset(SQLUpdate, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
      .MoveFirst
      Do Until rcd.EOF
            strBodyUpdate = strBodyUpdate & "Update:" & vbCrLf & "Date: " & .Fields(0) & vbCrLf & .Fields(1) & vbCrLf & vbCrLf
            .MoveNext
      Loop
      End If
End With
'Query Vehicles
VehicleBreak = "CASE VEHICLES SECTION" & vbCrLf
SQLVehicle = "SELECT tblsubjectvehicle.year, tblsubjectvehicle.make, tblsubjectvehicle.model, tblsubjectvehicle.bodytype, tblsubjectvehicle.color, tblsubjectvehicle.state, tblsubjectvehicle.registrationnumber FROM tblsubjectvehicle WHERE SubjectID =" & Me.subjectid

Set rcd = db.OpenRecordset(SQLVehicle, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
    .MoveFirst
   Do Until rcd.EOF
          strBodyVehicle = strBodyVehicle & "Year: " & .Fields(0) & vbCrLf & "Make: " & .Fields(1) & _
          "Model: " & .Fields(2) & vbCrLf & "Body Type: " & .Fields(3) & vbCrLf & "Color: " & .Fields(4) & vbCrLf & "State: " & .Fields(5) & vbCrLf & "Registration: " & .Fields(6) & vbCrLf & vbCrLf
         .MoveNext
  Loop
  End If
End With
'Query Activity
ActivityBreak = "CASE SCHEDULE SECTION" & vbCrLf
SQLActivity = "SELECT tblactivity.ActivityDate, tblactivity.ActivityTime, tblactivity.ActivityEndTime, tblactivity.ActivityType, tblactivity.activityPurpose, tblactivity.Description," _
& "tblactivity.notes, [tblemployees.firstname] & ' '  & [tblemployees.lastname] AS EmpName FROM tblactivity INNER JOIN tblemployees ON tblactivity.employeeid = tblemployees.employeeid" _
& " WHERE subjectid =" & Me.subjectid & " ORDER BY tblactivity.[ActivityDate]"


Set rcd = db.OpenRecordset(SQLActivity, dbOpenSnapshot)

With rcd
If Not (rcd.BOF And rcd.EOF) Then
    .MoveFirst
   Do Until rcd.EOF
          strBodyActivity = strBodyActivity & "Scheduled For: " & .Fields(0) & vbCrLf & .Fields(1) & _
          " - " & .Fields(2) & vbCrLf & "Type: " & .Fields(3) & vbCrLf & "Purpose: " & .Fields(4) & vbCrLf & "Description: " & .Fields(5) & "Notes: " & .Fields(6) & vbCrLf & "Employee: " & .Fields(7) & vbCrLf & vbCrLf
         .MoveNext
  Loop
  End If
End With
    Set objOLMail = objOL.CreateItem(olMailItem)
    With objOLMail
        .To = strToLeadEmail
        .cc = strToEmail
        '.BCC
        .subject = strsubjectLine
        .Body = CaseBreak & strBodyCase & AddressBreak & strBodyAddress & EmailAddressBreak & strBodyEmailAddress & WebAddressBreak & strBodyWebAddress & AddSubjectBreak & strBodyAddSubject & UpdateBreak & strBodyUpdate & VehicleBreak & strBodyVehicle & ActivityBreak & strBodyActivity
        If Nz(strpath, "") <> "" Then
            .Attachments.Add strpath
        End If
        .display
    End With
    DoCmd.Hourglass False
Exit_EmailUpdates:
      Set db = Nothing
      Set rcd = Nothing
      DoCmd.Hourglass False
      Exit Sub


End Sub

Select allOpen in new window