Dim Stmp As String
Dim OLap As Outlook.AppointmentItem
Dim OLrs As Outlook.Results
Dim OLsr As Outlook.Search
 
    Stmp = ""
    Stmp = Stmp & "urn:schemas:calendar:dtstart >= '" & Format(Now(), _
      "dd/mmm/yyyy") & "'"
    Stmp = Stmp & " AND "
    Stmp = Stmp & "urn:schemas:calendar:dtstart < '" & Format(Now() + 1, _
      "dd/mmm/yyyy") & "'"
 
Set OLsr = Outlook.AdvancedSearch(Scope:="Calendar", Filter:=Stmp, _
  SearchSubFolders:=False, Tag:="SearchWork")
Set OLrs = OLsr.Results
 
'OLrs.Sort "[Start]", True
 
    For Each OLap In OLrs        
          MsgBox OLap 
    Next OLap