Ha több mappában tárolja az elküldött e-maileket, és most szeretné ezeket az elküldött leveleket havonta számolni, akkor elolvashatja ezt a cikket. Itt bemutatunk egy meglehetősen gyors módot a beszerzésére.
Az előző cikk - "A bejövő e-mailek gyors számlálása dátum, hónap vagy év szerint az Outlook VBA segítségével” megosztott egy módszert az e-mailek havi bontására. Azonban képes feldolgozni az e-maileket egy mappában. Ha több vagy akár az összes levélmappában szeretné megszámolni az e-maileket, használja a másik módszert. Így a következőkben egy másik, sokkal gyorsabb módszert mutatunk be Önnek.
Számolja havonta az elküldött e-maileket
- Először nyissa meg az Outlook VBA szerkesztőjét az „Alt + F11” gombbal.
- Ezután engedélyezze az „MS Excel Object Library” a „Hogyan adjunk hozzá egy Object Lib-etrary Hivatkozás a VBA-ban".
- Ezután helyezze be a következő VBA-kódot egy projektbe vagy modulba.
Dim objDictionary As Object
Sub CountSentMailsByMonth()
Dim objOutlookFile As Outlook.Folder
Dim objFolder As Outlook.Folder
Dim objExcelApp As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet
Dim varMonths As Variant
Dim varItemCounts As Variant
Dim nLastRow As Integer
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
'Get the default Outlook data file
Set objOutlookFile = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Parent
For Each objFolder In objOutlookFile.Folders
If objFolder.DefaultItemType = olMailItem Then
Call ProcessFolders(objFolder)
End If
Next
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = True
Set objExcelWorkbook = objExcelApp.Workbooks.Add
Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
With objExcelWorksheet
.Cells(1, 1) = "Month"
.Cells(1, 2) = "Count"
End With
varMonths = objDictionary.Keys
varItemCounts = objDictionary.Items
For i = LBound(varMonths) To UBound(varMonths)
nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
With objExcelWorksheet
.Cells(nLastRow, 1) = varMonths(i)
.Cells(nLastRow, 2) = varItemCounts(i)
End With
Next
objExcelWorksheet.Columns("A:B").AutoFit
End Sub
Sub ProcessFolders(ByVal objCurFolder As Outlook.Folder)
Dim i As Long
Dim objMail As Outlook.MailItem
Dim strMonth As String
For i = objCurFolder.Items.Count To 1 Step -1
If objCurFolder.Items(i).Class = olMail Then
Set objMail = objCurFolder.Items(i)
'Change to your own email address
If objMail.SenderEmailAddress = "you@datanumen.com" Then
strMonth = Format(Year(objMail.SentOn) & "-" & Month(objMail.SentOn), "YYYY/MM")
If objDictionary.Exists(strMonth) Then
objDictionary(strMonth) = objDictionary(strMonth) + 1
Else
objDictionary.Add strMonth, 1
End If
End If
End If
Next
End Sub
- Ezután vigye a kurzort az első szubrutinra.
- Ezt követően nyomja meg az „F5” billentyűt a makró aktiválásához.
- Egyszerre megjelenik egy Excel-fájl, amely az alábbi ábrán látható módon tartalmazza a minden hónapban elküldött e-mailek számát.
Ne essen pánikba az Outlook korrupciójával szemben
Hajlamos lehet aggodalomra, amikor PST-károsodást tapasztal. A valóságban azonban jobb, ha mielőbb megnyugodsz. Mint mindannyian tudjuk, a pánik tehetetlen, sőt kaotikusabb és súlyosabb problémákhoz vezet. Nyugodtan meg kell fontolnia az intézkedéseket, például át kell gondolnia, hogy frissítette-e a biztonsági másolatot, és meg kell fontolnia, hogyan tegye javítás PST – igénybe kell-e venni harmadik féltől származó eszközt, mint például DataNumen Outlook Repair vagy lépjen kapcsolatba a megfelelő szakemberekkel.
Szerző Bevezetés:
Shirley Zhang adat-helyreállítási szakértő DataNumen, Inc., amely világelső az adat-helyreállítási technológiák területén, beleértve javítás mdf és outlook javítószoftver termékek. További információért látogasson el www.datanumen.com

