Kako brzo izvesti ukupan broj stavki u svakoj Outlook mapi u Excel

Ako želite dobiti izvješće o broju stavki u svakoj Outlook mapi, možete koristiti metodu predstavljenu u ovom članku. Brzo će izvršiti brojanje i izvesti rezultate u Excel datoteku.

U mom prethodnom članku – “Kako brzo dobiti ukupan broj stavki u mapi i svim njezinim podmapama putem programa Outlook VBA”, možete naučiti metodu pomoću VBA za dobivanje broja stavki u mapi. Međutim, na taj način, ako želite brojati stavke u svim mapama, morate odabrati svaku mapu i pokrenuti makro jednu po jednu. Malo je zamorno. Stoga ćemo vas naučiti drugu metodu, koja će izvesti brojanje u Excel datoteku.

Izvezite ukupan broj stavki u svakoj Outlook mapi u Excel

1. Na početku pokrenite svoj Outlook program.
2. Zatim pritisnite tipke "Alt + F11" u glavnom prozoru programa Outlook.
3. Zatim ćete ući u prozor “Microsoft Visual Basic for Applications” u kojem trebate otvoriti modul koji nije u upotrebi.
4. Nakon toga kopirajte i zalijepite sljedeći VBA kod u ovaj modul.

Public strExcelFile As String
Public objExcelApp As Excel.Application
Public objExcelWorkbook As Excel.Workbook
Public objExcelWorksheet As Excel.Worksheet

Sub Export_CountOfItems_InEachFolder_toExcel()
    Dim objSourcePST As Outlook.Folder
    Dim objFolder As Outlook.Folder
 
    'Create a new Excel file
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
    objExcelWorksheet.Cells(1, 1) = "Folder"
    objExcelWorksheet.Cells(1, 2) = "Count Items"
 
    'Select a source PST file
    Set objSourcePST = Outlook.Application.Session.PickFolder

    For Each objFolder In objSourcePST.folders
        Call ProcessFolders(objFolder)
    Next
 
    'Fit the columns from A to B
    objExcelWorksheet.Columns("A:B").AutoFit
 
    strExcelFile = "E:\Outlook\" & objSourcePST.Name & " Folder Items Count (" & Format(Now, "yyyy-mm-dd hh-mm-ss") & ").xlsx"
    objExcelWorkbook.Close True, strExcelFile

    MsgBox "Complete!", vbExclamation
End Sub

Sub ProcessFolders(ByVal objCurrentFolder As Outlook.Folder)
    Dim objItem As Object
    Dim lCurrentFolderItemCount As Long
    Dim nLastRow As Integer
 
    lCurrentFolderItemCount = objCurrentFolder.Items.Count
 
    nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1

    'Add the values into the columns
    objExcelWorksheet.Range("A" & nLastRow) = objCurrentFolder.FolderPath
    objExcelWorksheet.Range("B" & nLastRow) = lCurrentFolderItemCount
 
    If objCurrentFolder.folders.Count > 0 Then
       For Each objSubfolder In objCurrentFolder.folders
           Call ProcessFolders(objSubfolder)
       Next
    End If
End Sub

5. Nakon toga trebate promijeniti razinu sigurnosti Outlook makroa na nisku.
6. Zatim se možete vratiti na novo dodanu makronaredbu i pritisnuti tipku F5 za pokretanje ove makronaredbe.
7. Zatim trebate odabrati izvornu PST datoteku i pritisnuti "OK".
8. Nakon što makronaredba završi, možete otići u unaprijed definiranu lokalnu mapu kako biste pronašli novu Excel datoteku, koja će izgledati kao sljedeća snimka zaslona:

Riješite dosadne PST pogreške

Možda ste naišli na razne probleme tijekom korištenja Outlooka. Da biste riješili male probleme, možete jednostavno pribjeći alat za popravak inboxa. Unatoč tome, ako su problemi toliko ozbiljni da nadilaze ono što ugrađeni alat može učiniti, morate koristiti moćniji alat, 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 popravak mdf-a i softverske proizvode za popravak Outlooka. Za više informacija posjetite www.datanumen.com