?
Solved

How can I use a recordset in a report?

Posted on 2011-04-28
2
Medium Priority
?
147 Views
Last Modified: 2012-05-11
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

Open in new window

0
Comment
Question by:seanlhall
2 Comments
 
LVL 26

Accepted Solution

by:
Nick67 earned 2000 total points
ID: 35488305
Yes, it could be done.
Can you post as sample db with enough data to generate one email and a screenshot of the email that would be created?

Basically, you could create an empty report.
Put txtboxes on it, with CanGrow = true
textboxes

txtTo
txtCC
txtSubject
txtBody

and instead of putting all that text to
        .To = strToLeadEmail
        .cc = strToEmail
        '.BCC
        .subject = strsubjectLine
        .Body
you'd put it to
        me.txtTo = strToLeadEmail
        me.txtcc = strToEmail
        me.txtsubject = strsubjectLine
        me.txtBody =  CaseBreak & strBodyCase & AddressBreak & strBodyAddress & EmailAddressBreak & strBodyEmailAddress & WebAddressBreak & strBodyWebAddress & AddSubjectBreak & strBodyAddSubject & UpdateBreak & strBodyUpdate & VehicleBreak & strBodyVehicle & ActivityBreak & strBodyActivity

Catch my drift.
Text is text
Create the strings exactly the same way--just assign them to a report's textboxes instead of to an Outlook objects properties
Do so in the Report header Format event.

You may need a BS report recordsource of something like "1=1" just to get it to display
0
 

Author Closing Comment

by:seanlhall
ID: 35488756
That worked great. Thanks.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
Suggested Courses

830 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question