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

Ako želite da dobijete izveštaj o broju stavki u svakoj fascikli Outlook, 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 njenim podmapama putem Outlook VBA“, možete naučiti metodu pomoću VBA da dobijete broj stavki u fascikli. Međutim, na taj način, ako želite da prebrojite stavke u svim fasciklama, morate da izaberete svaku fasciklu i pokrenete makro jednu po jednu. Malo je zamorno. Stoga ćemo vas naučiti još jednoj metodi, koja će izvesti broj u Excel datoteku.

Izvezite ukupan broj stavki u svakoj Outlook fascikli 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 za aplikacije” 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, morate promijeniti nivo sigurnosti makroa Outlooka na niski.
6. Zatim se možete vratiti na novododati makro i pritisnuti tipku F5 da pokrenete ovaj makro.
7. Zatim morate odabrati izvornu PST datoteku i pritisnuti “OK”.
8. Nakon što se makro završi, možete otići u unaprijed definiranu lokalnu mapu da pronađete novu Excel datoteku, koja će izgledati kao na sljedećem snimku ekrana:

Smirite dosadne PST greške

Možda ste naišli na razne probleme tokom korištenja Outlooka. Da biste riješili male probleme, jednostavno možete pribjeći alat za popravku inboxa. Ipak, ako su problemi toliko ozbiljni da su prevazišli ono što ugrađeni alat može učiniti, morate koristiti moćniji alat, npr. DataNumen Outlook Repair.

Uvod za autora:

Shirley Zhang je stručnjak za oporavak podataka DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući mdf repair i Outlook softverski proizvodi za popravku. Za više informacija posjetite www.datanumen.com