Question

我正在寻找一个vba宏来计算昨天收件箱收件箱中的电子邮件数量。

发送时间往往会在午夜发送的电子邮件中丢失我的号码。

我计算完毕后，我需要将其添加到另外20个左右邮箱的电子邮件总数中。

当前脚本将填充邮箱中的所有电子邮件（无论日期如何），然后将按日期显示该文件夹中有多少电子邮件，因此它不是我真正需要的。

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 = objnSpace.Folders("Mailbox - IT Support Center").Folders("Onshore - Jim").Folders("completed1")
    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
Set dict = CreateObject("Scripting.Dictionary")
Set myItems = objFolder.Items
myItems.SetColumns ("ReceivedTime")
' Determine date of each message:
For Each myItem In myItems
    dateStr = GetDate(myItem.ReceivedTime)
    If Not dict.Exists(dateStr) Then
        dict(dateStr) = 0
    End If
    dict(dateStr) = CLng(dict(dateStr)) + 1
Next myItem

' Output counts per day:
msg = ""
For Each o In dict.Keys
    msg = msg & o & ": " & dict(o) & " items" & vbCrLf
Next
MsgBox msg

Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing

End Sub

Answer 1

让我们尝试简化您的代码：

Sub HowManyEmails()

Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
Dim MailItem
Dim EmailCount As Integer

Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")

On Error Resume Next
Set objFolder = objnSpace.GetDefaultFolder(olFolderInbox).Folders("Onshore - Jim").Folders("completed1")
On Error GoTo 0

If objFolder Is Nothing Then MsgBox "No Such Folder": Exit Sub

For Each MailItem In objFolder.Items
    If DatePart("d", Date - 1) = DatePart("d", MailItem.ReceivedTime) Then EmailCount = EmailCount + 1
Next

MsgBox EmailCount
Set objOutlook = Nothing
Set objnSpace = Nothing
Set objFolder = Nothing

End Sub

这会计算昨天收到的所有邮件，这些邮件存储在指定的文件夹中假设您的子文件夹位于.GetDefaultFolder(olFolderInbox)内，我添加了Inbox 这样，outlook就知道了搜索的确切位置。

但是，如果您没有访问收件箱文件夹而是邮箱中的另一个文件夹，该怎么办？上面的代码不起作用，你需要这样的东西：

Sub HowManyMails()

Dim objOutlook As Object, objnSpace As Object, objFolder, objNotInbox As MAPIFolder
Dim MailItem
Dim EmailCount As Integer
Dim strFolderName

Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = objnSpace.GetDefaultFolder(olFolderInbox) 'reference to default folder

strFolderName = objFolder.Parent 'referrence to Inbox's parent which is Mailbox

On Error Resume Next
Set objNotInbox = objnSpace.Folders(strFolderName).Folders("Onshore - Jim").Folders("completed1")
On Error GoTo 0

If objNotInbox Is Nothing Then MsgBox "No Such Folder": Exit Sub

For Each MailItem In objNotInbox.Items
    If DatePart("d", Date - 1) = DatePart("d", MailItem.ReceivedTime) Then EmailCount = EmailCount + 1
Next

MsgBox EmailCount
Set objOutlook = Nothing
Set objnSpace = Nothing
Set objFolder = Nothing

End Sub

以上内容将计算Mailbox（“邮箱 - IT支持中心”）中与Inbox（“OnShore -Jim”）级别相同级别的文件夹中的邮件数量文件夹）。
我删除了硬编码的邮箱名称，使其更具动态性，只需将其引用到Inbox父文件夹Mailbox。希望这能让你开始得到你想要的东西。

附加：（循环邮箱中的所有文件夹）

Sub HowManyMails()

Dim objOutlook As Object, objnSpace As Object, objFolder, objNotInbox As MAPIFolder
Dim MailItem
Dim EmailCount As Integer
Dim strFolderName
Dim FolderName() As Variant
Dim i As Integer

Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = objnSpace.GetDefaultFolder(olFolderInbox)

strFolderName = objFolder.Parent

ReDim FolderName(3) 'change this to how many folders you have

'assign each folder name on the array elements
FolderName(1) = "OnShore - Jim" 
FolderName(2) = "OnShore - John"
FolderName(3) = "OnShore - Ben"

'loop through each foldername
For i = 1 To 3
    On Error Resume Next
    Set objNotInbox = objnSpace.Folders(strFolderName).Folders(FolderName(i)).Folders("completed1")
    On Error GoTo 0

    If objNotInbox Is Nothing Then GoTo skip

    For Each MailItem In objNotInbox.Items
        If DatePart("d", Date - 1) = DatePart("d", MailItem.ReceivedTime) Then EmailCount = EmailCount + 1
    Next
skip:
Next

MsgBox EmailCount

End Sub

在上面的代码中，我假设您的文件夹不在Inbox内如果文件夹位于Inbox内，请改为修改第一个代码。

用于计算昨天电子邮件的vba宏

1 个答案: