Export Multiple Table Records to Email Body

[maxsun08]

Hi All,

I've managed to write a script to send one record to the body of email, but I'm lost on how to get all records in a table to the body.

Any advice is greatly appreciated!

Regards,

 

[pr2-eugin]

If you do not mind, could you show the script you have written to send one record via email?

 

[maxsun08]

Eugin,

Thanks for looking into this! Here's what I have so far which works great expect I can't get more than one record.

Private Sub Command21_Click()

'On Error GoTo Errorhandler
    
    Dim olApp As Object
    Dim olItem As Variant
    Dim olatt As String
    Dim olMailTem As Variant
    Dim strSendTo As String
    Dim strMsg As String
    Dim strTo As String
    Dim strcc As String
    Dim rst As DAO.Recordset
    Dim rs As DAO.Recordset
    Dim db As DAO.Database
    Dim qry As DAO.QueryDef
    Dim fld As Field
    Dim varItem As Variant
    Dim strtable As String
    Dim rec As DAO.Recordset
    Dim strqry As String

    strqry = "SELECT tblTestTemp.AirOpsID, tblTestTemp.PassengerEmpID, tblMasterPersonnel.LastName, tblMasterPersonnel.FirstName, " & _
            "tblTestTemp.Date, tblTestTemp.PSiteID, tblTestTemp.DSiteID " & _
            "FROM tblMasterPersonnel RIGHT JOIN tblTestTemp ON tblMasterPersonnel.EmpID = tblTestTemp.PassengerEmpID; "

    Set db = CurrentDb
    Set rec = CurrentDb.OpenRecordset(strqry)
'        If Not (rec.BOF And rec.EOF) Then
'        rec.MoveLast
'        rec.MoveFirst
'        intCount = rec.RecordCount
'            For intLoop = 1 To intCount
'
'            rec.MoveNext
'
'            Next intLoop
'        End If

    strSendTo = ""
    
    strTo = ""
    strcc = ""
    
    Set olApp = CreateObject("Outlook.application")
    Set olItem = olApp.createitem(olMailTem)
    
    olItem.Display
    olItem.To = strTo
    olItem.cc = strcc
    olItem.Subject = "one record works so far"
    olItem.Body = rec("AirOpsID") & " " & rec("PassengerEmpID") & " " & rec("LastName") & " " & rec("FirstName") & " " & rec("Date") & " " & rec("PSiteID") & " " & rec("DSiteID")
    MsgBox "Completed Export"
    Set olApp = Nothing
    Set olItem = Nothing

Exit_Command21_Click:
    Exit Sub
ErrorHandler:
    MsgBox Err.Description, , Err.Number
    Resume Exit_Command21_Click

End Sub

 

[pr2-eugin]

Just put the body statement inside the for loop.. something like..

Private Sub Command21_Click()

'On Error GoTo Errorhandler
    
    Dim olApp As Object
    Dim olItem As Variant
    Dim olatt As String
    Dim olMailTem As Variant
    Dim strSendTo As String
    Dim strMsg As String
    Dim strTo As String
    Dim strcc As String
    Dim rst As DAO.Recordset
    Dim rs As DAO.Recordset
    Dim db As DAO.Database
    Dim qry As DAO.QueryDef
    Dim fld As Field
    Dim varItem As Variant
    Dim strtable As String
    Dim rec As DAO.Recordset
    Dim strqry As String

    strqry = "SELECT tblTestTemp.AirOpsID, tblTestTemp.PassengerEmpID, tblMasterPersonnel.LastName, tblMasterPersonnel.FirstName, " & _
            "tblTestTemp.Date, tblTestTemp.PSiteID, tblTestTemp.DSiteID " & _
            "FROM tblMasterPersonnel RIGHT JOIN tblTestTemp ON tblMasterPersonnel.EmpID = tblTestTemp.PassengerEmpID; "

    strSendTo = ""
    
    strTo = ""
    strcc = ""
    
    Set olApp = CreateObject("Outlook.application")
    Set olItem = olApp.createitem(olMailTem)
    
    olItem.Display
    olItem.To = strTo
    olItem.cc = strcc
    olItem.Body = ""
    olItem.Subject = "This should work !"
    
    Set db = CurrentDb
    Set rec = CurrentDb.OpenRecordset(strqry)
    If Not (rec.BOF And rec.EOF) Then
        rec.MoveLast
        rec.MoveFirst
        intCount = rec.RecordCount
            For intLoop = 1 To intCount
                olItem.Body = olItem.Body & rec("AirOpsID") & " " & rec("PassengerEmpID") & " " & rec("LastName") & " " & rec("FirstName") & " " & rec("Date") & " " & rec("PSiteID") & " " & rec("DSiteID") & Chr(10)
                rec.MoveNext
            Next intLoop
    End If

    MsgBox "Completed Export"
    Set olApp = Nothing
    Set olItem = Nothing

Exit_Command21_Click:
    Exit Sub
ErrorHandler:
    MsgBox Err.Description, , Err.Number
    Resume Exit_Command21_Click

End Sub

My only worry is how large the body would be.. try this.. and let me know how it goes..

 

[maxsun08]

Works perfectly, many thanks! The strqry pulls from a temptbl and there won't be more than 20-40 records each time.

Thank you again! Cheers

 

[pr2-eugin]

You are most welcome..

 

[maxsun08]

I don't like to be bothersome however I do have another question that I thought would be simple and maybe it is but its eluding me. How can I filter records where AirOpsID = "1" and send those to the email instead of all records?

Regards,

 

[pr2-eugin]

You can use FindFirst method available in the recordset..

rec.FindFirst "AirOpsID = 1"

 

[maxsun08]

So I've been attempting but I can't make it work. Ultimately, what I'm trying to do is all records with AirOpsId = 1, put those records in an email, then records with AirOpsID = 2 in a different email and so forth but no luck.

 

[pr2-eugin]

Then why not use separate query?

rec = db.openRecordSet (SELECT * FROM someTable WHERE AirOpsID=1)

 

[maxsun08]

Eugin,

I got it albeit probably not the most efficient way but it works. Basically, I used IF THEN for each AIROPSID, the one below is for ="1" then the rest follow suit.

'searches strqry rec for any AirOpsID = 1
    rec.MoveLast
    With rec
        .FindFirst "AirOpsID = 1"
        If .NoMatch Then
        MsgBox "no records found"
        .MoveFirst
        Else
            strSendTo = ""
            strTo = ""
            strcc = ""

            Set olApp = CreateObject("Outlook.application")
            Set olItem = olApp.createitem(olMailTem)

            olItem.Display
            olItem.To = strTo
            olItem.cc = strcc
            olItem.Body = ""
            olItem.Subject = "This should work !"

            Set db = CurrentDb
    
            Set rec1 = CurrentDb.OpenRecordset(strqry1)
                If Not (rec1.BOF And rec1.EOF) Then

                rec1.MoveLast
                rec1.MoveFirst

                intCount = rec1.RecordCount

                For intLoop = 1 To intCount
                    olItem.Body = olItem.Body & rec1("AirOpsID") & " " & rec1("LastName1") & " " & rec1("FirstName") & " " & rec1("DateLeg1") & " " & rec1("PickUpSiteIDLeg1") & " " & rec1("DropOffSiteIDLeg1") & Chr(10)
                    rec1.MoveNext
                Next intLoop
                End If

        End If
    End With

Thanks for your help! Very much appreciated again!