creating outlook msg from access

[David b]

Let me explain what I am doing
This a livestock management system for farmers.

This bit of it deals with the need for farmers to register their new born calves on a government database within a couple
of weeks of birth.
So the email always goes to data@sis.defra.gsi.gov.uk".
The rs [BCMSREGgrab] contains the details of the calf or calves that are due for birth notification
The spec for the email says that each calf (record) has to be on a single line but any number can be included on
a single email
This is the bit I am having bother with, looping through the rs and picking up each calf`s details - to go in strmessage.
The message body should look like this when ready to send.

IPASIS|1.02|1004001|4|20030302100438

UK107248100317|24/02/2003|F|DS||UK N0348 00721|||31/402/0034||31/402/0034|
UK107248200318|27/02/2003|M|DS||UK N0348 00712|||31/402/0034||31/402/0034|
UK107248300319|27/02/2003|M|DS||UK N0348 00712|||31/402/0034||31/402/0034|
UK107248700316|23/02/2003|F|DS||UK N0348 00512|||31/402/0034||31/402/0034|

The code below creates an email with only one record eg, only the identifyer line and the first calf line.
I need to get the remaining records in.
Would be grateful for any replies
David B
Hexham UK - kicking the cat and swearing at the wife !!!!

Code below --

Private Sub Command18_Click()

On Error GoTo Handler



Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Dim strMessage As String
Dim strsubject As String
Dim strspareline As String
Set rs = db.OpenRecordset("BCMSREGgrab")

If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst
Dim olObj As Outlook.Application

Dim olMail As Outlook.MailItem

Set olObj = New Outlook.Application

Set olMail = olObj.CreateItem(olMailItem)


Set olMail = olObj.CreateItem(olMailItem)
strMessage = Trim(rs![Tag No] & Chr(124) & rs![DOB] & Chr(124) & rs![Sex] & Chr(124) & rs![Breeds] & Chr(124) & rs![electID]
& Chr(124) & rs![Dam I D] & Chr(124) & rs![surrdamid] & Chr(124) & rs![Ear Tag] & Chr(124) & rs![Holding No] & Chr(124) &
rs![birthherdsuffix] & Chr(124) & rs![Holding No] & Chr(124) & rs![postherdsuffix]) 'data
strsubject = Trim(rs![BCMSapplicID] & Chr(124) & rs![BCMSVno] & Chr(124) & rs![BCMSorigionater ID] & Chr(124) &
rs.RecordCount & Chr(124) & rs![timestamp]) 'header
strspareline = ""
Do
rs.MoveNext

Loop Until rs.EOF



Do Until rs.EOF

rs.MoveNext
Loop
With olMail

.Subject = ""
.Body = strsubject & vbNewLine & strspareline & vbNewLine & strMessage & vbNewLine
.To = "data@sis.defra.gsi.gov.uk"
.Send
End With
Set olMail = Nothing


End If

exitsub:

olObj.Quit
Set olObj = Nothing
rs.Close
Set rs = Nothing
Set db = Nothing
MsgBox "Email has been created"
Exit Sub

Handler:
Select Case Err.Number
Case Else
MsgBox Err.Number & " " & Err.Description
Resume exitsub
End Select
End Sub

 

[Mile-O]

A you go through your RecordSet are there any criteria which says a record should be selected and added to the email message?

 

[David b]

Thanks for the reply.
The recordset is a query that has already sorted out which records are to go in the email
David B

 

[Mile-O]

Try changing a section of your code to this:

Do
strMessage = strMessage & vbCrLf & Trim(rs![Tag No] & Chr(124) & rs![DOB] & Chr(124) & rs![Sex] & Chr(124) & rs![Breeds] & Chr(124) & rs![electID]
& Chr(124) & rs![Dam I D] & Chr(124) & rs![surrdamid] & Chr(124) & rs![Ear Tag] & Chr(124) & rs![Holding No] & Chr(124) &
rs![birthherdsuffix] & Chr(124) & rs![Holding No] & Chr(124) & rs![postherdsuffix]) 'data
strsubject = Trim(rs![BCMSapplicID] & Chr(124) & rs![BCMSVno] & Chr(124) & rs![BCMSorigionater ID] & Chr(124) &
rs.RecordCount & Chr(124) & rs![timestamp]) 'header
strspareline = ""
rs.MoveNext

Loop Until rs.EOF

 

[David b]

YEEEEEEEEEEEES
progress at last. many thanks.
One little problem - It is grabbing the first record twice.
What is causing that ?
David B

 

[Mile-O]

You've got the same line before and withing the Do...Loop - you don't need it before the loop.

Private Sub Command18_Click()

On Error GoTo Handler



Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Dim strMessage As String
Dim strsubject As String
Dim strspareline As String
Set rs = db.OpenRecordset("BCMSREGgrab")

If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst
Dim olObj As Outlook.Application

Dim olMail As Outlook.MailItem

Set olObj = New Outlook.Application

Set olMail = olObj.CreateItem(olMailItem)


Set olMail = olObj.CreateItem(olMailItem)

Do
strMessage = Trim(rs![Tag No] & Chr(124) & rs![DOB] & Chr(124) & rs![Sex] & Chr(124) & rs![Breeds] & Chr(124) & rs![electID]
& Chr(124) & rs![Dam I D] & Chr(124) & rs![surrdamid] & Chr(124) & rs![Ear Tag] & Chr(124) & rs![Holding No] & Chr(124) &
rs![birthherdsuffix] & Chr(124) & rs![Holding No] & Chr(124) & rs![postherdsuffix]) 'data
strsubject = Trim(rs![BCMSapplicID] & Chr(124) & rs![BCMSVno] & Chr(124) & rs![BCMSorigionater ID] & Chr(124) &
rs.RecordCount & Chr(124) & rs![timestamp]) 'header
strspareline = ""
rs.MoveNext

Loop Until rs.EOF



Do Until rs.EOF

rs.MoveNext
Loop
With olMail

.Subject = ""
.Body = strsubject & vbNewLine & strspareline & vbNewLine & strMessage & vbNewLine
.To = "data@sis.defra.gsi.gov.uk"
.Send
End With
Set olMail = Nothing


End If

exitsub:

olObj.Quit
Set olObj = Nothing
rs.Close
Set rs = Nothing
Set db = Nothing
MsgBox "Email has been created"
Exit Sub

Handler:
Select Case Err.Number
Case Else
MsgBox Err.Number & " " & Err.Description
Resume exitsub
End Select
End Sub

 

[David b]

Thats cracked it. Many thanks for your help
David B