CODEWITHSUNDEEP
vbaoutlook
ORLANDO VAZQUEZ
ORLANDO VAZQUEZ

Reputation: 79

Check if no Outlook email, with today's date as received date, in folder using Access VBA

I check a specific folder to see if an email exists with today's date as the received date.

The code below loops through the emails and sends me an email message if an email exists with today's date as the received date.

I want it to also send me an email if there are zero results.

The closest I got was to get six results all indicating the mail item does not exist (since there were 6 messages with dates not equal to today).

For Each olMail In OlItems

        'Cond #1  Received today?
        If (Now() - olMail.ReceivedTime < 1) Then
            '...Cond #2 ...and has specific string
             If (InStr(1, olMail.Body, "L_Remittance_YYYYMMDD", 1) > 0) Then
                   '......'Cond #3  and Has attachment?
             If olMail.Attachments.Count > 0 Then
                         '..Cond 4 ...and has data in results  [ "0" evaluates to string not existing  ]  ?
             If (InStr(1, olMail.Body, "No Data Available", 1) = 0) Then


                      'Cond 1-4 all true then save to drop location
                      For j = 1 To olMail.Attachments.Count
                      olMail.Attachments.Item(j).SaveAsFile strFolder & 
                        olMail.Attachments.Item(j).FileName


            ''Loop through files in folder ie For Each o1Mail in OlItems
            Next j

                        'Cond 4
                       End If
                'Cond 3
                 End If
           'Cond 2
           End If
    ''Cond #1
    End If


    Next
    '' If (Now() - olMail.ReceivedTime < 1) = "" Then
    '' Call FailFile
    '' Else
    ''Exit Sub
    ''End If

    Set OlFolder = Nothing
    Set OlItems = Nothing
    Set olMail = Nothing
    Set OlApp = Nothing

     ''NO DATA IN FILE AS PER EMAIL BODY

    aFile = "H:\TEST_DROP\FileName_" & CurrentDate & ".csv"
    If Len(Dir$(aFile)) = 0 Then

       Call NoData

    End If


                ''YES TO DATA IN FILE

    aFile = "H:\TEST_DROP\Metlife_Remittance_Berkadia_" & CurrentDate & ".csv"
    If Len(Dir$(aFile)) > 0 Then
            Call Data
    End If


    End Sub

Upvotes: 0

Views: 1317

Answers (1)

urdearboy
urdearboy

Reputation: 14580

It looks like your first condition tracks the criteria you are looking for.

  1. Create Boolean variable rec_today
  2. Set rec_today = FALSE
  3. Loop through all emails
  4. Switch rec_today to TRUE ONLY IF your first condition is met
  5. Check condition of rec_today at the end of the loop.

Notice that if your first criteria is never met (email received today), rec_today will never be swapped to TRUE. Therefore, your actions should be based around the outcome of this variable.

Dim rec_today As Boolean            
rec_today = False                 '<---START AT FALSE

For Each olMail In OlItems
    If (Now() - olMail.ReceivedTime < 1) Then            '<--- FLIP TO TRUE HERE
      rec_today = True
        If (InStr(1, olMail.Body, "L_Remittance_YYYYMMDD", 1) > 0) Then
             If olMail.Attachments.Count > 0 Then
                If (InStr(1, olMail.Body, "No Data Available", 1) = 0) Then
                    For j = 1 To olMail.Attachments.Count
                        olMail.Attachments.Item(j).SaveAsFile strFolder & olMail.Attachments.Item(j).Filename
                    Next j
                End If
            End If
        End If
    End If
Next


If rec_today = TRUE Then
    'Code here that should run if email was found from today
Else      
    'Code here that should run if NO EMAIL was found from today
    'i.e. rec_today = FALSE
End If

End Sub

Upvotes: 1

Related Questions