Kako automatski zabilježiti ukupan broj dolaznih e-poruka svaki dan u Excel datoteku

Ovaj članak će vas naučiti kako pustiti Outlook da automatski broji koliko ste e-poruka primili svaki dan i zapisuje broj u Excel datoteku.

Mnogi korisnici moraju brojati ukupan broj primljenih e-poruka svaki dan. Osim toga, za praktičniju provjeru u budućnosti, mnogi su navikli bilježiti ukupni broj u Excel datoteku. U ovom slučaju, naravno, možete se odlučiti za ručno brojanje i snimanje svaki dan. Međutim, malo je problematično. I možda ćete to ponekad zaboraviti učiniti. Stoga morate poželjeti praktičnu metodu koja može natjerati Outlook da to automatski učini. Kao odgovor na ovaj zahtjev, u nastavku ćemo vas naučiti kako koristiti VBA za njegovu realizaciju.

Automatski zabilježite ukupan broj dolaznih e-poruka svaki dan u Excel datoteku

1. Na samom početku pokrenite svoju Outlook aplikaciju.
2. Zatim pritisnite prečace tipki “Alt + F11” u glavnom prozoru programa Outlook.
3. Zatim u skočnom prozoru uređivača VBA otvorite projekt “ThisOutlookSession”.
4. Nakon toga kopirajte i zalijepite sljedeće VBA kodove u ovaj projekt.

Private Sub Application_Reminder(ByVal Item As Object)
    If Item.Class = olTask And Item.Subject = "Update Email Count" Then
       Call GetAllInboxFolders
    End If
End Sub

Private Sub GetAllInboxFolders()
    Dim objInboxFolder As Outlook.Folder
    Dim strExcelFile As String
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim nNextEmptyRow As Integer
    Dim lEmailCount As Long
 
    lEmailCount = 0
    Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Call UpdateEmailCount(objInboxFolder, lEmailCount)
 
    ‘Change the path to the Excel file
    strExcelFile = "E:\Email\Email Count.xlsx"
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Open(strExcelFile)
    Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
 
    nNextEmptyRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
 
    'Add the values into the columns
    objExcelWorksheet.Range("A" & nNextEmptyRow) = nNextEmptyRow - 1
    objExcelWorksheet.Range("B" & nNextEmptyRow) = Year(Date - 1) & "-" & Month(Date - 1) & "-" & Day(Date - 1)
    objExcelWorksheet.Range("C" & nNextEmptyRow) = lEmailCount
 
    'Fit the columns from A to C
    objExcelWorksheet.Columns("A:C").AutoFit
   
    'Save the changes and close the Excel file
    objExcelWorkbook.Close SaveChanges:=True
End Sub

Private Sub UpdateEmailCount(objFolder As Outlook.Folder, ByRef lCurEmailCount As Long)
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strDay As String
    Dim strReceivedDate As String
    Dim lEmailCount As Long
    Dim objSubFolder As Outlook.Folder
 
    Set objItems = objFolder.Items
 
    objItems.SetColumns ("ReceivedTime")
    strDay = Year(Date - 1) & "-" & Month(Date - 1) & "-" & Day(Date - 1)
 
    For Each objItem In objItems
        If objItem.Class = olMail Then
           Set objMail = objItem
           strReceivedDate = Year(objMail.ReceivedTime) & "-" & Month(objMail.ReceivedTime) & "-" & Day(objMail.ReceivedTime)
           If strReceivedDate = strDay Then
              lCurEmailCount = lCurEmailCount + 1
           End If
        End If
    Next
 
    'Process the subfolders in the folder recursively
    If (objFolder.Folders.Count > 0) Then
       For Each objSubFolder In objFolder.Folders
           Call UpdateEmailCount(objSubFolder, lCurEmailCount)
       Next
    End If
End Sub

5. Zatim potpišite ovaj kod i promijenite postavke Outlook makronaredbi da biste dopustili potpisane makronaredbe.
6. Nakon toga morate kreirati zadatak koji se ponavlja na dnevnoj bazi.

• Najprije kliknite gumb "Novi zadatak" u oknu Zadaci.
• U skočnom prozoru Novi zadatak kliknite gumb "Ponavljanje".
• Zatim u sljedećem dijaloškom okviru odaberite "Dnevno", "Svaki 1 dan(a)" i "Bez datuma završetka" i na kraju pritisnite "U redu".
• Kasnije promijenite predmet zadatka i podsjetnik prema svojim potrebama.
• Na kraju kliknite gumb "Spremi i zatvori".

7. Od sada, svaki put kada se oglasi podsjetnik za ovaj zadatak, Outlook će automatski prebrojati e-poruke primljene jučer i zatim zabilježiti broj u Excel datoteku, kao na sljedećoj snimci zaslona:

Pobjegnite od trajnog gubitka PST podataka

Nitko nije spreman prihvatiti trajni gubitak PST podataka. Međutim, Outlook PST datoteka je sklona korupciji. Stoga biste trebali poduzeti odgovarajuće mjere opreza, poput izrade dosljedne i ažurirane sigurnosne kopije PST podataka i čuvanja moćnog PST oporavak alat u blizini, npr DataNumen Outlook Repair.

Uvod za autora:

Shirley Zhang stručnjakinja je za oporavak podataka u DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući sql popravak i softverske proizvode za popravak Outlooka. Za više informacija posjetite www.datanumen.com