使用Outlook VBA将邮件类别数据发送到Excel [英] Send mail category data to Excel using Outlook VBA

问题描述

我按类别统计Outlook中的电子邮件数量.

I count the number of emails in Outlook by Category.

我在MsgBox中获取输出.

I am getting the output in a MsgBox.

我想要Excel中的输出.

I want the output in Excel.

示例-

电子邮件类别
物料(蓝色)42
供应商(绿色)5

Category No of Emails
Material(blue) 42
Vendor(green) 5

宏的用法如下

Sub CategoriesEmails()

Dim oFolder As MAPIFolder
Dim oDict As Object
Dim sStartDate As String
Dim sEndDate As String
Dim oItems As Outlook.Items
Dim sStr As String
Dim sMsg As String

On Error Resume Next
Set oFolder = Application.ActiveExplorer.CurrentFolder

Set oDict = CreateObject("Scripting.Dictionary")

sStartDate = Date - 365
sEndDate = Date
Set oItems = oFolder.Items.Restrict("[Received] >= '" & sStartDate & "' And [Received] <= '" & sEndDate & "'")
oItems.SetColumns ("Categories")

For Each aitem In oItems
    sStr = aitem.Categories
    If Not oDict.Exists(sStr) Then
        oDict(sStr) = 0
    End If
    oDict(sStr) = CLng(oDict(sStr)) + 1
Next aitem

sMsg = ""
For Each aKey In oDict.Keys
    sMsg = sMsg & aKey & ":   " & oDict(aKey) & vbCrLf
Next
MsgBox sMsg

Set oFolder = Nothing

End Sub

推荐答案

根据您的代码，我已经更新了我的代码，您可以粘贴所有代码并运行它:

Based on your code, I've updated my code, you can paste all and run it:

 Sub CategoriesEmails()

    Dim oFolder As MAPIFolder
    Dim oDict As Object
    Dim sStartDate As String
    Dim sEndDate As String
    Dim oItems As Outlook.Items
    Dim sStr As String
    Dim sMsg As String
    Dim strFldr As String
    Dim OutMail As Object
    Dim xlApp As Object

    On Error Resume Next
    Set oFolder = Application.ActiveExplorer.CurrentFolder

    Set oDict = CreateObject("Scripting.Dictionary")

    sStartDate = Date - 365
    sEndDate = Date
    Set oItems = oFolder.Items.Restrict("[Received] >= '" & sStartDate & "' And [Received] <= '" & sEndDate & "'")
    oItems.SetColumns ("Categories")

    For Each aItem In oItems
    sStr = aItem.Categories
    If Not oDict.Exists(sStr) Then
    oDict(sStr) = 0
    End If
    oDict(sStr) = CLng(oDict(sStr)) + 1
    Next aItem

    sMsg = ""
    i = 0

    strFldr = "D:\"
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Application.Visible = True
    xlApp.Workbooks.Open strFldr & "test.xlsx"
    xlApp.Sheets("Sheet1").Select
    For Each aKey In oDict.Keys
    xlApp.Range("a1").Offset(i, 0).Value = sMsg & aKey
    xlApp.Range("B1").Offset(i, 0).Value = oDict(aKey) & vbCrLf
    i = i + 1
    Next
    xlApp.Save

    Set oFolder = Nothing

     End Sub

您可以根据实际情况更改fileUrl，fileName，Excel字段.

You could change the fileUrl, fileName, Excel field as your actual situation.

这篇关于使用Outlook VBA将邮件类别数据发送到Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！