Jos tallennat lähetetyt sähköpostit useisiin kansioihin ja haluat nyt laskea kaikki nämä lähetetyt sähköpostit kuukausittain, voit lukea tämän artikkelin. Tässä esitellään huomattavan nopea tapa saada se.
Edellinen artikkeli - “Kuinka nopeasti laskea saapuvat sähköpostit päivämäärän, kuukauden tai vuoden mukaan Outlook VBA: n kautta”On jakanut tavan laskea sähköpostit kuukausittain. Se pystyy kuitenkin käsittelemään sähköpostit yhdessä kansiossa. Jos haluat laskea sähköpostit useisiin tai jopa kaikkiin sähköpostikansioihin, käytä muita tapoja. Siksi seuraavissa paljastamme sinulle toisen paljon nopeamman tavan.
Laske lähetetyt sähköpostit kuukausittain
- Ensinnäkin, käytä Outlook VBA -editoria "Alt + F11" -toiminnolla.
- Ota sitten käyttöön viittaus ”MS Excel Object Library "mukaan"Objektin lisääminen Library Viite VBA: ssa".
- Tämän jälkeen laita seuraava VBA-koodi projektiin tai moduuliin.
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
- Siirrä sitten kohdistin ensimmäiseen aliohjelmaan.
- Paina sitten “F5” käynnistääksesi tämän makron.
- Samanaikaisesti tulee näkyviin Excel-tiedosto, joka sisältää lähetettyjen sähköpostien määrät kuukausittain, kuten alla olevassa kuvassa näkyy.
Älä paniikkia Outlookin korruption edessä
Saatat olla yleensä huolissasi, kun kohtaat PST-vaurioita. Todellisuudessa sinun on kuitenkin parempi rauhoittua mahdollisimman pian. Kuten me kaikki tiedämme, paniikki on avutonta ja johtaa jopa kaoottisempiin ja vakavampiin ongelmiin. Sinun tulisi olla rauhallinen harkita toimenpiteitä, kuten miettiä, oletko päivittänyt varmuuskopion, ja miettiä miten korjaa PST - turvaako kolmannen osapuolen työkalu kuten DataNumen Outlook Repair tai ota yhteyttä asianomaisiin ammattilaisiin.
Tekijän esittely:
Shirley Zhang on tietojen palauttamisen asiantuntija DataNumen, Inc., joka on maailman johtava tietojen palautustekniikoissa, mukaan lukien korjaus mdf ja Outlookin korjausohjelmistotuotteet. Lisätietoja osoitteessa www.datanumen.com

