Email attach using CDO

[cytruden]

Hello everyone,

I have a database that tracks equipment students check out. When they keep it too long, I want to send them an e-mail telling them to bring it back, with a report attached that tells them what they checked out.

I have been successful using the SendObject Method. I want to use CDO instead so I don't have to open an email client.

I am using CDO in conjunction with DoCmd.OutputTo acOutputReport.

I can get the code to send the emails WITHOUT the attachements.

I can get the code to make the reports without emailing them.

When I try to attach the reports to the email, it will do the first one, and generate a 2501 error "the Outputto action was canceled" on the second time through.

On the code listed below, if I comment out the line

objEmail.AddAttachment "D:\PEReport\PEEquipRpt.pdf"

I don't get the error code.

Here is the code:

Dim rst As DAO.Recordset
Dim strEmailAddress
Dim Firstname
Dim count
Dim SendMail
Dim StudID

Set rst = CurrentDb.OpenRecordset("EmailQuery")
count = 0
Do Until rst.EOF
strEmailAddress = strEmailAddress & rst("Email")
Firstname = Firstname & rst("Firstname")
StudID = StudID & rst("StudIDNum")
strSubject = "Physical Education Equipment Reminder"
strEMailMsg = "Dear " & Firstname & "," _
& Chr$(13) & Chr$(13) & "You have equipment checked out from the Physical Education equipment room that has not been returned." _
& Chr$(13) & Chr$(13) & "The attached report lists the equipment you have checked out." _

Forms!NavigationForm.StudID = StudID
DoCmd.OutputTo acOutputReport, "IndEquipOutRpt", acFormatPDF, "D:\PEReport\PEEquipRpt.pdf"

Set objEmail = CreateObject("CDO.Message")
objEmail.To = strEmailAddress
objEmail.From = "emailaddresshere"
objEmail.Subject = strSubject
objEmail.HTMLBody = strEMailMsg
objEmail.AddAttachment "D:\PEReport\PEEquipRpt.pdf"
objEmail.Configuration.Fields.Item _
(I am new so I can't post links, but this link is correct!") = 2
objEmail.Configuration.Fields.Item _
("I am new so I can't post links, but this link is correct!") = _
"mailserver.weber.edu"
objEmail.Configuration.Fields.Item _
("I am new so I can't post links, but this link is correct!) ") = 25
objEmail.Configuration.Fields.Update
objEmail.Send


strEmailAddress = ""
Firstname = ""
StudID = ""
count = count + 1


rst.MoveNext
Loop

rst.Close
Set rst = Nothing
End Sub

I have tried Kill to delete the file, and still get the error.

I have tried moving the file to a different folder before the second loop, and still get the error.

I am not sure why it won't save the output file the second time around.

Thank you in adavance for any help.

Tim

 

[ByteMyzer]

Have you tried a different filename for each student?

For the DoCmd.Output, use:

DoCmd.OutputTo acOutputReport, "IndEquipOutRpt", acFormatPDF, _
    "D:\PEReport\PEEquipRpt_" & [COLOR="Navy"]CStr[/COLOR](StudID) & ".pdf"

For the AddAttachment, use:

objEmail.AddAttachment "D:\PEReport\PEEquipRpt_" & [COLOR="navy"]CStr[/COLOR](StudID) & ".pdf"

 

[cytruden]

Thank you for the reply.

Great minds must think alike, because that is exactly what I ended up doing, and it worked perfectly.

The file was getting locked somehow, and I am still not sure how I would fix it, but I am happy with the workaround.

Nice of you to take time to help.