使用Outlook VBA将邮件类别数据发送到Excel [英] Send mail category data to Excel using Outlook VBA
本文介绍了使用Outlook VBA将邮件类别数据发送到Excel的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
我按类别统计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屋!
查看全文