我需要一個宏來計算髮送的電子郵件的數量(全部在一個發送文件夾中,沒有子文件夾)並將結果記錄到文件(csv或txt)。輸出文件應該說明每個日期的電子郵件數量,發件人地址/名稱和收件人的域名(@ company.com)。計算Outlook發件箱項目並記錄到文件
我能夠讓這段代碼部分工作,但它只顯示輸出文件中的電子郵件的日期和數量。
此外 - 有沒有辦法將新數據追加到文件,而不是覆蓋它?
Outlook中的消息框確實是可選的,輸出文件是關鍵部分。
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("[email protected]").Folders("Outbox")
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
Dim fso As Object
Dim fo As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fo = fso.CreateTextFile("C:\Users\xxx\Documents\outlook_test_log.txt")
fo.Write msg
fo.Close
Set fo = Nothing
Set fso = Nothing
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
End Sub
Function GetDate(dt As Date) As String
GetDate = Year(dt) & "-" & Month(dt) & "-" & Day(dt)
End Function
要附加到現有的文件,使用'OpenTextFile'與參數'ForAppending'如[在此解釋](https://msdn.microsoft.com/en-us/library/aa265347(v = vs.60).aspx)。 –
您是否希望電子郵件坐在發件箱中等待發貨?或者您是否想要捕獲正在發送的電子郵件? –
對不起,我犯了一個錯誤 - 實際上我想記錄已發送的電子郵件 - 而不是等待發送或隨時登錄。所以基本上每天要通過一次發送的電子郵件,並將符合條件的項目記錄到文件中... – ondas