使用Outlook VBA将邮件类别数据发送到Excel

Question

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

我在MsgBox中获取输出。

我想要Excel中的输出。

示例-

电子邮件类别
材质（蓝色）42
供应商（绿色）5

宏的用法如下

$conn = new mysqli($servername, $username, $password, $dbname);

Answer 1

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

 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字段。