Test To see if attachment exists and if not append record to table

[Fiat77]

I have a function listed below which works great. I need to add a condition to this because we may be in position to send all these emails out t once rather than displaying them one at a time.

I need a condition that tests to see if a file exists based on the path created. If the path does not have an attachment, I need the code to append the code field to a table named Tbl_NoFile, then go through and run the code in its entirety looping through each record and sending an attachment based on the file path for each record.

How can I modify this to test if an attachment for this basepath exists and if not append a reord for the Code field with no attachment to a table named Tbl_NoFile? Thanks

************************************

Function ProductionFile()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim rs As DAO.Recordset
Dim formFilter As String
Dim strFilter As String
Dim basePath As String

basePath = "I:\" & ([Forms]![Frm_Persons]![TxtYear]) & "\" & ([Forms]![Frm_Persons]![TxtMonth]) & "\"

formFilter = ""
If Not IsNull(([Forms]![z_FFil2_frmCustom_800_600]![WhereSQL])) Then
formFilter = ([Forms]![z_FFil2_frmCustom_800_600]![WhereSQL])
End If

strFilter = ""
If Not IsNull(formFilter) And Len(formFilter) > 0 Then
strFilter = " where " & formFilter
End If

'MsgBox ([Forms]![z_FFil2_frmCustom_800_600]![WhereSQL])
Set OutApp = New Outlook.Application
Set rs = CurrentDb.OpenRecordset("SELECT

,[EMail_Address], [Person],[Message] FROM Qry_Persons" & strFilter)
        
        'On Error GoTo cleanup
       ' On Error Resume Next
    While Not rs.EOF
        Set OutMail = OutApp.CreateItem(olMailItem)
        With OutMail
            .To = rs("EMail_Address").Value
            .SentOnBehalfOfName = "Great Pay
           .Subject = rs("Person").Value & " Report for " & Format(Date, "Long Date")
            .Body = rs("Message").Value
'            .Attachments.Add rs("Actual_Path").Value
            .Attachments.Add (basePath & (rs("Code").Value) & ".pdf")
            .send

        End With

        Set OutMail = Nothing
        rs.MoveNext
    Wend
cleanup:
   Set OutApp = Nothing
   rs.Close
   Set rs = Nothing
   MsgBox "EMail List is Complete!", vbOKOnly
End Function

 

[KenReay]

Hi

You mean like:

If Dir(basePath & rs("Code").Value) & ".pdf") <> "" Then
' file exists
' do whatever
else
' no file
end if

Regards

Ken Reay
Freelance Solutions Developer
Boldon Information Systems Ltd
Website needs upgrading, but for now -

http://www.kenneth.reay.btinternet.co.uk

UK