VBA to email from recordset

[Sketchin]

Hello, I have this code that is giving me a runtime error "3241: Data type conversion error".

I am trying to click a command button that will create an outlook email, populating the email address field with the emails gathered in QryConfirmedEmail.

Here is my code:

Dim strConn As String
Dim myQueryDef As QueryDef
Dim rst As Recordset
Dim oOApp_001 As Outlook.Application
Dim oOApp_001_B As Outlook.Application
Dim oOMail_001 As Outlook.MailItem
Dim conn As ADODB.Connection
Dim eTotal As Long
Dim distro As String
Dim i As Long
Dim strQuery As String


Set oOApp_001 = CreateObject("Outlook.Application")
Set oOMail_001 = oOApp_001.CreateItem(olMailItem)

'q below just calls all recs from table with emails

strQuery = "QryConfirmedEmail"
Set myQueryDef = CurrentDb.QueryDefs("QryConfirmedEmail")
Set rst = myQueryDef.OpenRecordset(strQuery, dbOpenDynaset)

'This DCOUNT will count the number of records and put it in eTotal
eTotal = DCount("[E-Mail Address]", "tblContacts")

'Sets the email distro to blank
distro = ""

'Starts a for loop for the number of email addresses in the table
For i = 1 To eTotal
'concats each name together with ;
distro = distro & ";" & rst.Fields("[E-Mail Address]")
'In the loop, need to move to the next record to concat email address
'If trys to move pass last rec, then cause error, so checked for last rec before moving
If i <> eTotal Then
rst.MoveNext
End If

Next i

With oOMail_001
'now use the variable disto with all the email names in the to field of outlook
.To = distro
.Body = "Please find attached."
End With
End Sub

Cheers and Happy Haloween!

 

[pbaldy]

What line throws the error?

Rather than the For/Next loop and all, why not just loop the recordset?

Do While Not rst.EOF
  'do your thing
  rst.MoveNext
Loop

 

[Sketchin]

Line with the error is:
Set rst = myQueryDef.OpenRecordset(strQuery, dbOpenDynaset)

I noticed that I don't have DAO referenced. What I do have is Dim rs As Recordset rather than DAO.Recordset.

I also decided to use an SQL statement rather than parameters for the recordset.

New Code:

Dim strConn As String
Dim myQueryDef As QueryDef
[COLOR=red]Dim rst As DAO.Recordset
Dim db As DAO.Database
[/COLOR]Dim oOApp_001 As Outlook.Application
Dim oOApp_001_B As Outlook.Application
Dim oOMail_001 As Outlook.MailItem
Dim conn As ADODB.Connection
Dim eTotal As Long
Dim distro As String
Dim i As Long
Dim strQuery As String
[COLOR=red]Dim strSql As String[/COLOR]

[COLOR=red]Set db = CurrentDb()[/COLOR]
Set oOApp_001 = CreateObject("Outlook.Application")
Set oOMail_001 = oOApp_001.CreateItem(olMailItem)
[COLOR=red]strSql = "SELECT tblTrainingContacts.TrainingID, Contacts.[E-mail Address], tblTrainingContacts.Confirmed" & _
" FROM Contacts INNER JOIN tblTrainingContacts ON Contacts.ID = tblTrainingContacts.ContactID " & _
" WHERE (((tblTrainingContacts.TrainingID)=Forms!frmTraining!txtTrainingID) And ((tblTrainingContacts.Confirmed)=True)) "[/COLOR]
'q below just calls all recs from table with emails
strQuery = "QryConfirmedEmail"
Set myQueryDef = CurrentDb.QueryDefs("QryConfirmedEmail")
'Set rst = myQueryDef.OpenRecordset(strQuery, dbOpenDynaset)
[COLOR=red]Set rst = myQueryDef.OpenRecordset(strSql)[/COLOR]
'This DCOUNT will count the number of records and put it in eTotal
eTotal = DCount("[E-Mail Address]", "tblContacts")
'Sets the email distro to blank
distro = ""
'Starts a for loop for the number of email addresses in the table
For i = 1 To eTotal
'concats each name together with ;
distro = distro & ";" & rst.Fields("[E-Mail Address]")
'In the loop, need to move to the next record to concat email address
'If trys to move pass last rec, then cause error, so checked for last rec before moving
If i <> eTotal Then
rst.MoveNext
End If

Next i
 
With oOMail_001
'now use the variable disto with all the email names in the to field of outlook
.To = distro
.Body = "Please find attached."
End With
End Sub

 

[pbaldy]

Well, to use the SQL (which is what I would do) you'd have:

Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)

You will have to concatenate the form reference into the SQL, with delimiters if the field is text. If numeric:

" WHERE tblTrainingContacts.TrainingID = " & Forms!frmTraining!txtTrainingID & " And tblTrainingContacts.Confirmed=True"

 

[Sketchin]

Ok, Im a lot closer now. Just have to figure out the looping part I think. Currently it fails on:

distro = distro & ";" & rst.Fields("[E-Mail Address]")

Fails with "No Current Record"

Leaving the office soon, will have to check into this tomorrow

 

[pbaldy]

Go into debug mode and see if the variable has values. My guess is that you've gone to EOF. I'd try changing the loop to what I mentioned, which is a lot cleaner.

 

[Sketchin]

Alright Paul, I think I am getting closer. Now when I click the button, I know the sql code runs, but other than that, nothing is happening. I would expect that the email window from outlook would at least be popping up, but it isnt. Also, no errors are being raised.

Here is my code:

Private Sub cmdEmailConfirmed_Click()

Dim strConn As String
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim oOApp_001 As Outlook.Application
Dim oOMail_001 As Outlook.MailItem
Dim eTotal As Long
Dim distro As String
Dim i As Long
Dim strQuery As String
Dim strSql As String

Set db = CurrentDb()
Set oOApp_001 = CreateObject("Outlook.Application")
Set oOMail_001 = oOApp_001.CreateItem(olMailItem)

strSql = "SELECT tblTrainingContacts.TrainingID, Contacts.[E-mail Address], tblTrainingContacts.Confirmed" & _
" FROM Contacts INNER JOIN tblTrainingContacts ON Contacts.ID = tblTrainingContacts.ContactID " & _
" WHERE tblTrainingContacts.TrainingID = " & Forms!frmTraining!txtTrainingID & " And tblTrainingContacts.Confirmed=True"
Debug.Print strSql
Set rst = db.OpenRecordset(strSql, dbOpenDynaset)

'If recordset is empty, exit
Do While Not rst.EOF

'Sets the email distro to blank
distro = ""
distro = distro & ";" & rst.Fields("[E-Mail Address]")

rst.MoveNext
'Next i

With oOMail_001
'now use the variable disto with all the email names in the to field of outlook
.To = distro
.Body = "Please find attached."

End With

Loop
rst.Close
Set rst = Nothing
Set db = Nothing

End Sub

 

[pbaldy]

Try adding

.Display

after .Body, and move "Loop" above the With block (presuming you want a single email sent to multiple recipients).

 

[Sketchin]

Sooooo close! There is a problem with the looping (I think) If I click "send email", It will open a new email but only populate the last email in the query.

 

[Sketchin]

Got it! I had distro = "" inside my loop! Silly mistake!

This whole problem has been haunting me forever, very very happy to have this working!

Thanks again for the help Paul!

 

[Catalina]

Sketchin,

Would you mind posting the whole code?
I'm working on something similar and I may learn from it.
What do I say? I will learn from it.

Thanks,

Catalina

 

[Sketchin]

No prob:

Private Sub cmdEmailConfirmed_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim oOApp_001 As Outlook.Application
Dim oOMail_001 As Outlook.MailItem
Dim distro As String
Dim strSql As String

Set db = CurrentDb()
'Sets the email distro and subject line to blank
distro = ""

Set oOApp_001 = CreateObject("Outlook.Application")
Set oOMail_001 = oOApp_001.CreateItem(olMailItem)

 

strSql = "SELECT tblTrainingContacts.TrainingID, Contacts.[E-mail Address], tblTrainingContacts.Confirmed" & _
" FROM Contacts INNER JOIN tblTrainingContacts ON Contacts.ID = tblTrainingContacts.ContactID " & _
" WHERE tblTrainingContacts.TrainingID = " & Forms!frmTraining!txtTrainingID & " And tblTrainingContacts.Confirmed=True"

Set rst = db.OpenRecordset(strSql, dbOpenDynaset)
'If recordset is empty, exit
Do While Not rst.EOF
distro = distro & ";" & rst.Fields("[E-Mail Address]")
rst.MoveNext
Loop
With oOMail_001
'now use the variable disto with all the email names in the to field of outlook
.CC = 
.BCC = distro
.Subject = SOMETHING
.Body = "Please find attached."
.Display
.BodyFormat = 1
End With

rst.Close
Set rst = Nothing
Set db = Nothing
End Sub

Now I am trying to get the subject name in there based on which training session I am holding

 

[pbaldy]

Thanks again for the help Paul!

Sorry, I was in a meeting. Happy to help!

You should be able to the the subject by referring to a form, if that's where it will be.

 

[Sketchin]

Got the subject, starting on the body. May need help getting dates in there. So far, I have changed the SQL string to include training start and end dates, and in the body of the email I want something like this:

Body = "You been CONFIRMED for TECTERRA'S " & rst.Fields("BomDescription") & " Training" & vbCrLf & _
       "Date:" & rst.Fields("TrainingStartDate") & " To " & rst.Fields("TrainingEndDate") & vbCrLf & _
       "fsf"
 
SOME CODE HERE
 
.body = body

I feel like I am missing a DateSerial, or something like that to get it to display. Any ideas?

 

[pbaldy]

You shouldn't need DateSerial if those are really dates. Maybe the Format() function. What are you getting now?

 

[Catalina]

Thanks Sketchin and Paul, your efforts to get this working will benefit me as well!

Catalina

 

[pbaldy]

No problem. That's the beauty of a forum like this; it leaves a searchable archive that can help others later.

 

[Sketchin]

Basically nothing shows up at all. This is what Im using

vbTab & "Date:" & rst.Fields("TrainingStartDate") & " To " & rst.Fields("TrainingEndDate") & vbCrLf & _

Trainingstartdate being a date/time field

 

[pbaldy]

If nothing is showing up, not even the literal text, something else is going on. Can you post the db here?

 

[Sketchin]

Can I email it to you?