Sayma ve Okunmamış E-postaları paylaşma tarihi için paylaşılan posta kutusu için

Question

Gereksinimime uyacak şekilde Yığın Taşması'nda bulduğum VBA'yı düzenledim.

Bana, varsayılan gelen kutusu tarih bilgim ve tarihleri ​​olmayan okunmamış e-postaların sayısının e-posta sayısını verir.

Paylaşılan posta kutunun e-postalarını saymak gerekiyor. Örneğin, Redstreamattmail ve varsayılan posta kutusu değil, genel e-postalar ve okunmamış e-postalar için DATE WISE.

Sub HowManyEmails()  

Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder  
Dim EmailCount As Integer  

Dim a As Outlook.Application  
Dim b As Outlook.NameSpace  
Dim c As Outlook.MAPIFolder  

Set a = New Outlook.Application  
Set b = a.GetNamespace("MAPI")  
Set c = b.GetDefaultFolder(olFolderInbox)  
d = c.UnReadItemCount  

Set objOutlook = CreateObject("Outlook.Application")  
Set objnSpace = objOutlook.GetNamespace("MAPI")  

On Error Resume Next  

Set objFolder = objnSpace.GetDefaultFolder(olFolderInbox)  

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 & " Total Unread  email count are " & d  

Dim dateStr As String  
Dim myItems As Outlook.Items  
Dim dict As Object  
Dim msg, msg1 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:  
For Each o In dict.Keys  
    msg = msg & o & ": " & dict(o) & " Email items" & vbCrLf  
Next  
msg1 = "unread Emails are  " & d  

Set objFolder = Nothing  
Set objnSpace = Nothing  
Set objOutlook = Nothing  

'Send Email  
Set OutApp = CreateObject("outlook.Application")  
Set OutMail = OutApp.CreateItem(o)  

With OutMail  
    .Subject = "Count of emails"  
    .To = "name@company.com;"  
    .Body = msg & msg1  
    .Display  
    '.Send  
End With  

Set OutMail = Nothing  
Set OutApp = Nothing  

End Sub  

Answer 1

Dene: Orada doğru klasör adını koydu

Set c = b.Folders("Name of shared mailbox") 

.