Email from Access 2010 with Outlook - ms-access

Question

The code below creates an email. It only works on the first record of the db. Also, the code puts all of the fields in the body. I would like it to only put the fields that have "Request from Finance" in the field.
Private Sub cmdEMail_Click()
On Error GoTo cmdEMail_Click_Error
Dim OutApp As Object
Dim strEMail As String
Dim OutMail As Object
Dim strbody As String
strEMail = Me.EMail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Please add the following time codes to Oracle for Lilly Project 1005894. Thank you!" & vbCrLf _
& "" & vbCrLf & "INSTRUCTIONS:" & vbCrLf _
& "" & vbCrLf & "Make sure the Task Description starts with EU. This is automatically added by entering EU in the Contract field on the form." & vbCrLf _
& "" & vbCrLf & "If you wish to keep track of your time code requests, CC: yourself on the e-mail and considering entering a compound name or other identifier in the subject line. Alternatively, save a copy of the spreadsheet with your time codes to your desktop." & vbCrLf _
& "" & vbCrLf & "WRITING TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![WriterTaskNumberName] & vbCrLf _
& "" & vbCrLf & "ADD DRAFT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![AddDraftTaskNumberName] & vbCrLf _
& "" & vbCrLf & "EDIT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![EditTaskNumberName] & vbCrLf _
& "" & vbCrLf & "QUALITY REVIEW TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![DataIntegrityQRTaskNumber] & vbCrLf _
& "" & vbCrLf & "Task Description =" & [Forms]![frm_Regulatory]![Text186] & vbCrLf
On Error Resume Next
If Me.ActiveWritingCode = "Request from Finance" Then
With OutMail
.To = strEMail
.CC = ""
.BCC = ""
.Subject = "Lilly EU 1005894 Time Code Request"
.Body = strbody & vbNewLine & .Body
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End If
On Error GoTo 0
Exit Sub
cmdEMail_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdEMail_Click of Sub Form_frm_Regulatory"
End Sub

Answer 1

Here is a generic script to loop through records in a table.
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Contacts")
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs.EOF = True
'Perform an edit
'rs.Edit
'rs!VendorYN = True
'rs("VendorYN") = True 'The other way to refer to a field
'rs.Update
'Save contact name into a variable
'sContactName = rs!FirstName & " " & rs!LastName
'Move to the next record. Don't ever forget to do this.
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Finished looping through records."
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
Here is another example which is quite good.
https://msdn.microsoft.com/en-us/library/bb243789(v=office.12).aspx