How to verify that a mail from today exist in outlook, excel VBA-CodePudding

So i just want to see if an email exist in a particular folder. Everything works besides this. I just want a simple error handler if the mail isn't there. But how do i check? i've tried a lot of different things, please get me on the right path. The one here is not right, but that's what i want to do?

Sub Get_Calls_MTD_Data()

    'making sure windows not jumping forth and back
    Application.ScreenUpdating = False
    
    Dim getCalls As Workbook
    Dim releaseCalls As Workbook
    Dim fPat As String
    fPat = ThisWorkbook.Path
    Dim SNDate As String
    
    'The sheetname gets the date for the day name, so using variable for that
    SNDate = Date
    
                   
                   
         
         '-------------------
         'Error handling doesn't work
                'this dosent work any longer?
'         If Dir(fPat & "\Outlookdata\calls mtd\" & Date & "." & "***") = "" Then
'
'            MsgBox "does not find mail"
'
'         Else
            
            'making sure the windows dosen jump forth and back and no alerts
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            
              '---------------------------
            Set getCalls = Workbooks.Open(fPat & "\Outlookdata\Calls mtd\" & Date & "." & "*")
            
            Set releaseCalls = Workbooks.Open(fPat & "\" & ThisWorkbook.Name)
            
                           
        
               
                getCalls.Activate

                
                If Not IsEmpty(Range("G2").Value) = True Then
                
                     'finding last row
                     mylastagent = getCalls.Sheets(SNDate).Cells(Rows.Count, "G").End(xlUp).Row
                    
                     
                    
                     getCalls.Sheets(SNDate).Range("G2:H" & mylastagent).Copy
                     
                     
                     releaseCalls.Activate
                     
                     
                     releaseCalls.Sheets("calls").Range("A1").PasteSpecial xlPasteValues
                End If
                

               
               
                getCalls.Close
                
                
                Application.ScreenUpdating = True
                Application.DisplayAlerts = True
                            
                
                 Range("M3").Select
                                 
                
                Update_Day_When_Calls_Updates
        
            'Just the end if for the faulty error handling in the top
           ' End If

    

End Sub

So do i have to make a loop first to go through the folder, and then look if that loop finds an email from today? But how. Also i started to get the prompt "clipboard has to much information, do you want to save it" in the end, nothing works to get rid of that one.

Tried everything i can, looked here too for instance: Disable clipboard prompt in Excel VBA on workbook close

This is how i solved it :)

Public RecivedToday As String

Sub Check_If_Mail_From_Today_Exists_Calls_Daily()

    Dim ol As Outlook.Application
    Dim ns As Outlook.Namespace
    Dim fol As Outlook.folder
    Dim i As Object
    Dim mi As Outlook.MailItem
    
     
    
    Set ol = New Outlook.Application
    Set ns = ol.GetNamespace("MAPI")
    Set fol = ns.Folders("[email protected]").Folders("OutlookData").Folders("Calls Daily")
    
   
    For Each i In fol.Items
    
        If i.Class = olMail Then
                Set mi = i
                If mi.Attachments.Count > 1 And Format(mi.ReceivedTime, "yyyy-mm-dd") = Format(Date, "yyyy-mm-dd") Then
                    'Debug.Print Format(mi.ReceivedTime, "yyyy-mm-dd")
                    RecivedToday = Format(Date, "yyyy-mm-dd")
                    'Debug.Print RecivedToday
                End If
        End If
        
    Next i
    
       
    

End Sub

CodePudding user response：

Don't use strict date checks in Outlook. Instead, you need to use the Find/FindNext or Restrict methods of the Items class that allows getting only items that correspond to the search criteria. In the search criteria I'd recommend using less or greater conditions for dates.

Outlook evaluates date-time values according to the time format, short date format, and long date format settings in the Regional and Language Options applet in the Windows Control Panel. In particular, Outlook evaluates time according to that specified time format without seconds. If you specify seconds in the date-time comparison string, the filter will not operate as expected.

Although dates and times are typically stored with a date format, filters using the Jet and DAV Searching and Locating (DASL) syntax require that the date-time value to be converted to a string representation. In Jet syntax, the date-time comparison string should be enclosed in either double quotes or single quotes. In DASL syntax, the date-time comparison string should be enclosed in single quotes.

To make sure that the date-time comparison string is formatted as Microsoft Outlook expects, use the Visual Basic for Applications Format function (or its equivalent in your programming language).

'This filter uses urn:schemas:httpmail namespace 
    strFilter = AddQuotes("urn:schemas:httpmail:datereceived") _ 
    & " > '" & datStartUTC & "' AND " _ 
    & AddQuotes("urn:schemas:httpmail:datereceived") _ 
    & " < '" & datEndUTC & "'"

See Filtering Items Using a Date-time Comparison for more information.

Read more about the Find/FindNext and Restrict methods in the articles I wrote for the technical blog:

If you need to search for items in multiple folders you may consider using the AdvancedSearch method of the Application class, see Advanced search in Outlook programmatically: C#, VB.NET.

CodePudding user response：

In the case of "today's mail", if processing time is noticeable, you can .Sort then stop processing once older mail is found.

Option Explicit

Sub Check_If_Mail_From_Today_Exists_Calls_Daily()

    ' Where code is not in Outlook
    ' Reference Microsoft Outlook nn.n Object Library
    Dim ol As Outlook.Application
    Dim fol As Outlook.Folder
    Dim mi As Outlook.MailItem
    
    Set ol = New Outlook.Application
    Set fol = Session.Folders("[email protected]")
    Set fol = fol.Folders("OutlookData")
    Set fol = fol.Folders("Calls Daily")
    
    Dim folItems As Items
    Set folItems = fol.Items
    folItems.Sort "[ReceivedTime]", True
    
    Dim j As Long
    For j = 1 To folItems.Count
    
        If folItems(j).Class = olMail Then
        
            Set mi = folItems(j)
            
            If mi.Attachments.count > 1 Then
                If Format(mi.ReceivedTime, "yyyy-mm-dd") = Format(Date, "yyyy-mm-dd") Then
                    Debug.Print mi.Subject
                    Debug.Print " " & Format(mi.ReceivedTime, "yyyy-mm-dd")
                Else
                    'Older mail
                    Exit For
                End If
            End If

        End If
        
    Next

End Sub

.Restrict and .Find could be applied to all cases.

CodePudding user response：

I managed to do it like this, probably not the best way, no certainly not the best way, but i solved it for my needs :) Thanks Niton.

Public RecivedToday As String

Sub Check_If_Mail_From_Today_Exists_Calls_Daily()

    Dim ol As Outlook.Application
    Dim ns As Outlook.Namespace
    Dim fol As Outlook.folder
    Dim i As Object
    Dim mi As Outlook.MailItem
    
     
    
    Set ol = New Outlook.Application
    Set ns = ol.GetNamespace("MAPI")
    Set fol = ns.Folders("[email protected]").Folders("OutlookData").Folders("Calls Daily")
    
   
    For Each i In fol.Items
    
        If i.Class = olMail Then
                Set mi = i
                If mi.Attachments.Count > 1 And Format(mi.ReceivedTime, "yyyy-mm-dd") = Format(Date, "yyyy-mm-dd") Then
                    'Debug.Print Format(mi.ReceivedTime, "yyyy-mm-dd")
                    RecivedToday = Format(Date, "yyyy-mm-dd")
                    'Debug.Print RecivedToday
                End If
        End If
        
    Next i
    
       
    

End Sub