Counting Kategorien in Outlook VBA-Makro

Question

Der folgende Code nicht Kategorien von bestimmtem Tag richtig zählt:

Sub HowManyEmails() 
Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder 
Dim EmailCount As Integer 
Set objOutlook = CreateObject("Outlook.Application") 
Set objnSpace = objOutlook.GetNamespace("MAPI") 
    On Error Resume Next 
    Set objFolder = Session.GetFolderFromID(Application.ActiveExplorer.CurrentFolder.EntryID) 
    If Err.Number <> 0 Then 
    Err.Clear 
    MsgBox "No such folder." 
    Exit Sub 
    End If 
EmailCount = objFolder.Items.Count 
MsgBox "Number of emails in the folder: " & EmailCount, , "email count" 
Dim dateStr As String 
Dim myItems As Outlook.Items 
Dim dict As Object 
Dim msg As String 
Dim oDate As String 

Set dict = CreateObject("Scripting.Dictionary") 
oDate = InputBox("Date for count (Format D-M-YYYY") 
Set myItems = objFolder.Items.Restrict("[Received] >= '" & oDate & "'") 
myItems.SetColumns ("Categories") 
For Each myItem In myItems 
    dateStr = myItem.Categories 
    If Not dict.Exists(dateStr) Then 
     dict(dateStr) = 0 
    End If 
    dict(dateStr) = CLng(dict(dateStr)) + 1 
Next myItem 
msg = "" 
For Each o In dict.Keys 
    msg = msg & o & ": " & dict(o) & vbCrLf 
Next 
MsgBox msg 
Set objFolder = Nothing 
Set objnSpace = Nothing 
Set objOutlook = Nothing 
End Sub 

Wenn Sie ein Datum zu schreiben, sind die Ausgabekategorien und E-Mails nur zählen, die nicht die gewählten überein Datum. Ich bin vba total neu, also könntest du mir vielleicht sagen, wie es behoben werden kann? Danke für Hilfe!

Answer 1

Das Datumsformat, das für jemand anderen gültig ist, ist wahrscheinlich nicht für Sie gültig.

Option Explicit 

Private Sub HowManyEmails() 

    Dim objFolder As Folder 
    Dim EmailCount As Integer 

    Dim myItem As Object 
    Dim o As Variant 

    Dim dateStr As String 
    Dim myItems As items 
    Dim dict As Object 
    Dim msg As String 
    Dim oDate As String 

    On Error Resume Next 
    Set objFolder = ActiveExplorer.CurrentFolder 

    If err.number <> 0 Then 
     err.Clear 
     MsgBox "No such folder." 
     Exit Sub 
    End If 

    ' Must closely follow an On Error Resume Next 
    On Error GoTo 0 

    EmailCount = objFolder.items.count 
    MsgBox "Number of emails in the folder: " & EmailCount, , "email count" 

    Set dict = CreateObject("Scripting.Dictionary") 

    ' oDate = InputBox("Date for count (Format D-M-YYYY") 
    oDate = InputBox("Date for count (Format YYYY-m-d") 

    Set myItems = objFolder.items.Restrict("[Received] >= '" & oDate & "'") 

    ' myItems.SetColumns ("Categories") ' You will find this error due to On Error GoTo 0 

    For Each myItem In myItems 
     dateStr = myItem.Categories 
     If Not dict.exists(dateStr) Then 
      dict(dateStr) = 0 
     End If 
     dict(dateStr) = CLng(dict(dateStr)) + 1 
    Next myItem 

    msg = "" 
    For Each o In dict.Keys 
     If o = "" Then 
      msg = msg & dict(o) & ": " & "Not categorized" & vbCrLf 
     Else 
      msg = msg & dict(o) & ": " & o & vbCrLf 
     End If 
    Next 
    MsgBox msg 

ExitRoutine: 
    Set objFolder = Nothing 
    Set dict = Nothing 

End Sub