[英]How to set reference to shared inbox folder?
我在另一個搜索中找到了這個代碼,但是當我運行它時,我收到“沒有這樣的文件夾”錯誤。
我想計算共享收件箱文件夾中的電子郵件。 任何人都可以建議如何更改此代碼以完成此操作嗎?
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("Personal Folders").Folders("Inbox").Folders("report's").Folders("Customer")
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 ("SentOn")
' Determine date of each message:
For Each myItem In myItems
dateStr = GetDate(myItem.SentOn)
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
Function GetDate(dt As Date) As String
GetDate = Year(dt) & "-" & Month(dt) & "-" & Day(dt)
End Function
您將需要更新以下代碼行
Set objFolder = objnSpace.Folders("Personal Folders").Folders("Inbox").Folders("report's").Folders("Customer")
使用電子郵件地址更改Personal Folders
並在不需要時刪除該行的其余部分.Folders("report's").Folders("Customer")
或者簡單地使用Set objFolder = Application.Session.PickFolder
替換整行
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.