I have code which work when the attachment is sets C:\AccessFiles\some.pdf
However. I want to send a file that has been referenced in a text field within the table. The code gives a runtime error 438 but hovering over the line it stops at, shows the location and the file that I want to send out via the email. It stops here: .AddAttachment = rs.Fields("Formlocation")
What am I missing?
However. I want to send a file that has been referenced in a text field within the table. The code gives a runtime error 438 but hovering over the line it stops at, shows the location and the file that I want to send out via the email. It stops here: .AddAttachment = rs.Fields("Formlocation")
What am I missing?
Code:
Public Sub SendEmail()
Dim rs As DAO.Recordset
Dim imsg As Object
Dim iconf As Object
Dim flds As Object
Dim schema As String
Set imsg = CreateObject("CDO.Message")
Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields
' send one copy with SMTP server (with autentication)
schema = "http://schemas.microsoft.com/cdo/configuration/"
flds.Item(schema & "sendusing") = cdoSendUsingPort
flds.Item(schema & "smtpserver") = "servername"
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = cdoBasic
flds.Item(schema & "sendusername") = "email address"
flds.Item(schema & "sendpassword") = "password"
flds.Item(schema & "smtpusessl") = False
flds.Update
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
'Open the file for reading
Set f = fso.OpenTextFile("c:\AccessTextFiles\CraftFayreBookingConfirmation.txt", ForReading)
'The ReadAll method reads the entire file into the variable BodyText
BodyText = f.ReadAll
'Close the file
f.Close
Set f = Nothing
Set fso = Nothing
'this is ithe original line'Set rs = CurrentDb.OpenRecordset("SELECT * FROM TestTable") 'This is where the records come from, most likely a query run on demand
Set db = CurrentDb
Dim strSQL As String
Dim filename As String
'This line produces the recordset, People who have completed the booking process, sent their form and paymnt.
strSQL = "SELECT tblBookings.BookingID, tblParticipants.PName, tblParticipants.PEmail, tblEvents.EventName, " _
& "tblEvents.EventType, tblEvents.EventDate, tblEvents.FormLocation, tblEvents.EventID " _
& "FROM qryMaxBookingID INNER JOIN ((tblBookings INNER JOIN tblParticipants ON tblBookings.ParticipantID = tblParticipants.ParticipantID) " _
& "INNER JOIN tblEvents ON tblBookings.EventID = tblEvents.EventID) ON qryMaxBookingID.MaxOfBookingID = tblBookings.BookingID;"
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
filename = rs.Fields("FormLocation")
'This section loops through the recordset created above and using the txtfile above, creates the email and sends it
'to the email addresses within the recordset.
'These are the field placeholders <<sometext>> which correspond to the text file
If Not (rs.EOF And rs.BOF) Then
Do Until rs.EOF = True
'On Error Resume Next
With imsg
.To = rs.Fields("PEmail")
.BCC = "emailaddress"
.From = """name"" <emailaddress>"
.Subject = rs.Fields("EventName")
.AddAttachment = rs.Fields("Formlocation")
.TextBody = BodyText
.TextBody = Replace(.TextBody, "<<PName>>", rs!PName)
.TextBody = Replace(.TextBody, "<<EventName>>", rs!EventName)
.TextBody = Replace(.TextBody, "<<EventDate>>", rs!EventDate)
'.TextBody = Replace(.TextBody, "<<AmountPaid>>", "£" & rs!AmountPaid)
Set .Configuration = iconf
.Send
End With
rs.MoveNext
Loop
Set iconf = Nothing
Set imsg = Nothing
Set flds = Nothing
End If
MsgBox "Finished looping through records, all emails have been sent."
rs.Close 'Close the recordset
End Sub