Question

以下代码未正确计算特定日期的类别：

    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

当您撰写日期时，输出只是与所选日期不匹配的类别和电子邮件数。我对vba是全新的，所以也许你可以告诉我它是如何修复的？谢谢你的帮助！

Answer 1

对其他人有效的日期格式可能对您无效。

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

使用vba宏计算Outlook中的类别

1 个答案: