Check for attachment

I am trying to write a routine that will email from access using outlook. I have it working with a couple of issues. The first is that when emailing from a queried list in access, it needs to check to see if an attachment exists and then email it if it does. The attachments are excel files that follow a specific naming convention that could be worked into a statment I just don't know how to check if an excel file exists. The second issue is prior to emailing, it always gives me a warning about a program trying to send using outlook. Is there any way to turn this off or do I want to do that?

Here is my code:

Option Compare Database

Private Sub Command0___Click()

Dim aSubject As String
Dim abody As String
Dim RSSpecialist As Recordset
Dim strfolder As String
Dim strfile As String
Dim aattachments As String
Dim arecipients As String
Dim strSpecialistname As String
Dim qdf As DAO.QueryDef
Dim strsql As String


strfolder = Trim(Me!txtfolder)
If Right(strfolder, 1) <> "\" Then
strfolder = strfolder & "\"
End If

txtCurrProfile = Null
DoEvents


strsql = "SELECT distinct [FS Specialists].[FS Specialist], [FS Specialists].Manager, [FS Specialists].Email From [FS Specialists] Where [Program Status]= 'active';"


Set DB = CurrentDb
Set qdf = DB.CreateQueryDef("", strsql)
Set RSSpecialist = qdf.OpenRecordset

RSSpecialist.MoveFirst
Do Until RSSpecialist.EOF
strSpecialistname = RSSpecialist("FS Specialist")
strfile = "FS Specialist " & strSpecialistname & ".xlsx"
arecipients = RSSpecialist("Email") & ""
aSubject = "Data for Update"
abody = strSpecialistname & ", Please review the attached file and update past numbers as well as adding current."
aattachments = strfolder & "FS Specialist " & strSpecialistname & ".xlsx"
If Not IsNull(strSpecialistname) And Len(Trim(strfile)) < 19 Then
Call SendEmail(aSubject, arecipients, abody, aattachments, strfolder)
End If
RSSpecialist.MoveNext
If RSSpecialist.EOF Then Exit Do
Loop

Me!txtCurrProfile = "Email Complete..."
DoEvents

RSSpecialist.Close
DB.Close

Set xlapp = Nothing
Set RSSpecialist = Nothing
Set DB = Nothing
End Sub


Private Sub SendEmail(aSubject As String, arecipients As String, abody As String, aattachments As String, strfolder As String)

Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem

Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

With objEmail
.To = arecipients
' If Not IsNull(txtCCemail) Then
' .CC = strCCemail
' End If
.Subject = aSubject
.Body = abody
.Attachments.Add (aattachments)
.Send
End With

objOutlook.Quit
Set objEmail = Nothing

End Sub

Thanks!

 

[Delindan]

I found something that would help in the following thread and it worked great:

thread702-1358379