Set BUNCH_OF_Items = CurrentFolder.Items
Set filtereditmsextract1 = BUNCH_OF_Items.Restrict("[ReceivedTime] >= '" & Format(StartDate, "ddddd h:nn AMPM") & "' And [ReceivedTime] <= '" & Format(EndDate, "ddddd ") & "11:59 PM" & "'")
Extract1 = filtereditmsextract1.Count
For i = 1 To Extract1
On Error Resume Next
'''Only for Poland Project == Strat ==
LineCat = WConf.Sheets("ExcludeCategory").Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
If LineCat > 1 Then
FINDCat = filtereditmsextract1.Item(i).Categories
If FINDCat <> "" Then
Set WsConfCat = WConf.Sheets("ExcludeCategory")
WsConfCat.Activate
Set FOUNDCELLCat = WsConfCat.Range("A:A").Find(What:=FINDCat, LookAt:=xlWhole, LookIn:=xlValues) 'change this range
If Not FOUNDCELLCat Is Nothing Then
GoTo NextItem
End If
End If
'''Only for Poland Project == End ==
End If
Line = wks.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1
wks.Range("A" & Line) = filtereditmsextract1.Item(i).Attachments.Count 'IIf(UCase(CurrentFolder.Name) = "SENT ITEMS", "Sent Email", "Received Email") 'CurrentFolder.FolderPath
wks.Range("B" & Line) = CurrentFolder.Store.DisplayName
wks.Range("C" & Line) = filtereditmsextract1.Item(i).Categories
wks.Range("D" & Line) = filtereditmsextract1.Item(i).To
wks.Range("E" & Line) = filtereditmsextract1.Item(i).SenderName
wks.Range("F" & Line) = filtereditmsextract1.Item(i).CC
'wks.Range("F" & Line) = Left(filteredItmsExtract1.Item(i).Subject, Len(filteredItmsExtract1.Item(i).Subject) - Len(filteredItmsExtract1.Item(i).ConversationTopic))
' Select Case UCase(Trim(wks.Range("F" & Line).Value))
' Case "RE:", "FW:", "FWD:", "AW:", "WG:", "SV:", "VS:", "VL:", "TR:", "R:", "RIF:", "I:", "FS:", "VB:", "RV:", "RES:", "ENC:", "ODP:", "PD:", "YNT:", "ILT:", "ACCEPTED:", "DECLINED:", "TENTATIVE:", "PROPOSE NEW TIME:"
' Case Else
' wks.Range("F" & Line) = "New"
' End Select
wks.Range("G" & Line) = filtereditmsextract1.Item(i).ConversationTopic
'wks.Range("H" & Line) = filteredItmsExtract1.Item(i).Body
wks.Range("H" & Line) = CurrentFolder.FolderPath 'CurrentFolder.Name
wks.Range("I" & Line) = filtereditmsextract1.Item(i).ReceivedTime
wks.Range("P" & Line) = filtereditmsextract1.Item(i).Attachments.Item(1).DisplayName '.Item(i).FileName
'wks.Range("J" & Line) = GetLastVerb(filtereditmsextract1.Item(i)) 'filteredItmsExtract1.Item(i).LastModificationTime
'convert date
Dim stemp As String
stemp = GetLastVerb(filtereditmsextract1.Item(i))
If IsDate(stemp) Then
wks.Range("J" & Line).Value = CDate(stemp)
Else
wks.Range("J" & Line).Value = stemp
End If
If wks.Range("J" & Line) <> "" Then
wks.Range("A" & Line) = Round(wks.Range("J" & Line) - wks.Range("I" & Line), 0)
Else
wks.Range("N" & Line) = Round(Now() - wks.Range("I" & Line), 0)
End If
wks.Range("K" & Line) = (Len(filtereditmsextract1.Item(i).ConversationIndex) - 44) / 10 'VBA.IIf((filteredItmsExtract1.Item(i).UnRead), "Yes", "No")
wks.Range("M" & Line) = CurrentFolder.Name
wks.Range("O" & Line) = Now()
saveAttachments_1 filtereditmsextract1.Item(i), MakeFolders & "\"
NextItem:
filtereditmsextract1.Item(i) = Nothing
Next i