VBA Outlook, Extract flagged mailitem of specified time

[Mallesh23]

Hi Team,

I am using below code which works on my system, But its not working on Client System.
Client is using outlook 2010...... but his flagged mailitem is in shared folder of outlook.

Task is it has to select flagged mailitem of specified time selected by user from Dropdown.
all those mailitem has to be attached to new mail.

Can you suggest whats wrong with the below Code, or is it because user is using Shared outlook folder.

 Sub PickOutlookFolder_Path()
    Dim objNS As Namespace
    Dim strFolderPath As String
    Dim strEntryID As String
    'Set Outlook Object
    Set objNS = Outlook.GetNamespace("MAPI")
    Set objFolder = objNS.PickFolder
    If TypeName(objFolder) <> "Nothing" Then
        strFolderPath = objFolder.FolderPath
        strEntryID = objFolder.EntryID
    End If
    mac.Range("b4").Value = strFolderPath
End Sub


Public filename As String
Public path As String
Public objFolder As Folder
Sub FX_Broker()

   If mac.Range("b4").Value = "" Then
        MsgBox " Your Master Workbooks File path should not be Blank", vbCritical, "Fx Broker"
        Exit Sub
    End If

StartTime = Timer

Dim objApp As Outlook.Application
Set objApp = New Outlook.Application
Dim objMail As Outlook.MailItem
Set objNS = GetNamespace("MAPI")
Dim olFolder As Outlook.MAPIFolder
Dim myNewFolder As Outlook.MAPIFolder
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objFolder


Dim Item As Object
Dim olItem As MailItem
Dim objMsg As MailItem
Dim objMsg2 As MailItem
Dim objMsg3 As MailItem

Set objMsg = objApp.CreateItem(olMailItem)
Set objMsg2 = objApp.CreateItem(olMailItem)
Set objMsg3 = objApp.CreateItem(olMailItem)




SFILTER = "[ReceivedTime]>'" & Format(Date, "DDDDD HH:NN") & "'"

Debug.Print vbCr & SFILTER
Set oOlResults = objFolder.Items.Restrict(SFILTER)


t1 = Format(TimeValue(Now), "hh:mm AM/PM")

d = Format(Date, "DD") & "/" & Format(Date, "MM") & "/" & Format(Date, "YYYY")
t = Time
Dim currTime As Date
currTime = Time()



For Each Item In oOlResults
If TypeOf Item Is Outlook.MailItem Then
        MailRT = Item.ReceivedTime
        flagclr = Item.FlagIcon
        If flagclr = 6 Then
     
       '3am to 2:30pm
        'If TimeValue(currTime) >= TimeValue("3:00:00") And TimeValue(currTime) < TimeValue("14:30:00") Then
    
       If TimeValue(MailRT) >= mac.Range("A15").Value And TimeValue(MailRT) < mac.Range("B15").Value Then
        If TimeValue(MailRT) >= TimeValue("3:00:00") And TimeValue(MailRT) < TimeValue("14:30:00") Then
          With objMsg
              .To = mac.Range("a10").Value
              .CC = mac.Range("b10").Value
           
              .Body = "Hi All," & vbNewLine & mac.Range("d11").Value
              .Subject = mac.Range("c10").Value & " " & "(" & t1 & ")" & " - " & d
              .Attachments.Add Item
              .Display
              '.send
            End With
        End If
        End If

       '2:30pm to 6:30pm
        If TimeValue(MailRT) >= mac.Range("A15").Value And TimeValue(MailRT) < mac.Range("B15").Value Then
        If TimeValue(MailRT) >= TimeValue("14:30:00") And TimeValue(MailRT) < TimeValue("18:30:00") Then
           With objMsg2
              .To = mac.Range("a10").Value
              .CC = mac.Range("b10").Value
              .Body = "Hi All," & vbNewLine & mac.Range("d11").Value
              .Subject = mac.Range("c10").Value & " " & "(" & t1 & ")" & " - " & d
              On Error Resume Next
              .Attachments.Add Item
              .Display
              '.send
            End With
        End If
    End If
      '6:30pm to 10:30pm
        If TimeValue(MailRT) >= mac.Range("A15").Value And TimeValue(MailRT) < mac.Range("B15").Value Then
       'If TimeValue(currTime) >= TimeValue("18:30:00") And TimeValue(currTime) < TimeValue("22:30:00") Then
      If TimeValue(MailRT) >= TimeValue("18:30:00") And TimeValue(MailRT) < TimeValue("22:30:00") Then
           With objMsg3
              .To = mac.Range("a10").Value
              .CC = mac.Range("b10").Value
              .Body = "Hi All," & vbNewLine & mac.Range("d11").Value
              .Subject = mac.Range("c10").Value & " " & "(" & t1 & ")" & " - " & d
                   On Error Resume Next
              .Attachments.Add Item
              .Display
              '.send
            End With
            End If
        End If
     
    End If
End If


nxt:
Next
'GoTo nxt
    MsgBox "Macro Successful Time Taken " & Format(Timer - StartTime, "00:00") & " Seconds."
         
End Sub

Thanks
mg