Hi, this is my code that works but every now and then it emails without the attachment - how can i change the code to check for attachment before sending the email.....
Private Sub Command48_Click()
Dim rst
Dim XL As Excel.Application
Set XL = CreateObject("excel.application")
Dim vFile
vFile = "Template Location Here"
Set rst = CurrentDb.OpenRecordset("AllJobs")
If rst.RecordCount = 0 Then
Dialog.Box "No Job Requests Today!", vbInformation, "Database Message"
Else
rst.MoveLast
Dialog.Box "A Total Of: " & rst.RecordCount & " Booking Requests Found And Will Be Emailed!", vbInformation, "Database Message"
rst.MoveFirst
With XL
.Visible = False
.Workbooks.Open vFile
.Sheets("JOBS").Select
.Range("A4").Select
.ActiveCell.CopyFromRecordset rst
.ActiveWorkbook.SaveAs filename:=(LOCATION HERE), password:="HA123"
.ActiveWorkbook.close
.Application.Quit
Dim signature As String
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail ' This creates a blank email and captures the users default signature.
.BodyFormat = olFormatHTML
.Display
End With
signature = OutMail.HTMLBody
strBodyText = "Hi,<br>" & _
"Please find attached appointment requests.<br>" & _
"Let me know if you have problems.<br>" & _
"<br><br>Thanks,<br>"
With OutMail
.To = "email address here"
.CC = ""
.BCC = ""
.Subject = "Job Request Notification"
.HTMLBody = strFntNormal & strBodyText & strTableBody & "<br><br>" & signature
.Attachments.Add "File Location Here"
.Send 'or use .Send
End With
'outlook tidy up
Set OutMail = Nothing
Set OutApp = Nothing
Kill "file location here and name"
Dialog.Box "All Data has been exported and has been sent", vbInformation, "Task Complete"
End With
End If
End Sub
Private Sub Command48_Click()
Dim rst
Dim XL As Excel.Application
Set XL = CreateObject("excel.application")
Dim vFile
vFile = "Template Location Here"
Set rst = CurrentDb.OpenRecordset("AllJobs")
If rst.RecordCount = 0 Then
Dialog.Box "No Job Requests Today!", vbInformation, "Database Message"
Else
rst.MoveLast
Dialog.Box "A Total Of: " & rst.RecordCount & " Booking Requests Found And Will Be Emailed!", vbInformation, "Database Message"
rst.MoveFirst
With XL
.Visible = False
.Workbooks.Open vFile
.Sheets("JOBS").Select
.Range("A4").Select
.ActiveCell.CopyFromRecordset rst
.ActiveWorkbook.SaveAs filename:=(LOCATION HERE), password:="HA123"
.ActiveWorkbook.close
.Application.Quit
Dim signature As String
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail ' This creates a blank email and captures the users default signature.
.BodyFormat = olFormatHTML
.Display
End With
signature = OutMail.HTMLBody
strBodyText = "Hi,<br>" & _
"Please find attached appointment requests.<br>" & _
"Let me know if you have problems.<br>" & _
"<br><br>Thanks,<br>"
With OutMail
.To = "email address here"
.CC = ""
.BCC = ""
.Subject = "Job Request Notification"
.HTMLBody = strFntNormal & strBodyText & strTableBody & "<br><br>" & signature
.Attachments.Add "File Location Here"
.Send 'or use .Send
End With
'outlook tidy up
Set OutMail = Nothing
Set OutApp = Nothing
Kill "file location here and name"
Dialog.Box "All Data has been exported and has been sent", vbInformation, "Task Complete"
End With
End If
End Sub