Preskoči na glavno vsebino

Kako prešteti število podmap pod določeno mapo v programu Outlook?

Recimo, da ste ustvarili nekaj map v korenski mapi. Zdaj želite vedeti, koliko podmap pod korensko mapo lahko naredite? Samo razširite korensko mapo in ročno preštejte vse podmape eno za drugo? Ta članek bo predstavil enostavno metodo za dosego tega cilja.

Štejte število podmap s kodo VBA


Štejte število podmap s kodo VBA

Naslednja koda VBA vam lahko pomaga prešteti število podmap v določeni korenski mapi v Outlooku. Naredite naslednje.

1. Pritisnite druga + F11 tipke za odpiranje Microsoft Visual Basic za aplikacije okno.

2. V Ljubljani Microsoft Visual Basic za aplikacije okno, kliknite Vstavi > Moduli. Nato kopirajte in prilepite spodnjo kodo VBA v okno Code.

Koda VBA: preštejte število podmap pod določeno mapo v programu Outlook

Sub CountSubFldsUnderRootFolder()
Dim xRootFolder As Folder
Dim xFolderCount As Long
Dim xFolder As Object
On Error Resume Next
'Set xRootFolder = Outlook.Application.ActiveExplorer.CurrentFolder
Set xRootFolder = Outlook.Application.Session.PickFolder
If TypeName(xRootFolder) = "Nothing" Then Exit Sub
If xRootFolder.Folders.Count < 1 Then
    MsgBox "No subfolders under " & Chr(34) & xRootFolder.Name & Chr(34) & ".", vbInformation, "Kutools for Outlook"
    Exit Sub
End If
For Each xFolder In xRootFolder.Folders
    If xFolder.Name <> "Conversation Action Settings" And xFolder.Name <> "Quick Step Settings" Then
        xFolderCount = xFolderCount + 1
        Call ProcessFolders(xFolder, xFolderCount)
    End If
Next
MsgBox xFolderCount & " subfolders under " & Chr(34) & xRootFolder.Name & Chr(34) & ".", vbInformation, "Kutools for Outlook"
End Sub

Sub ProcessFolders(SubFolder As MAPIFolder, Num As Long)
Dim xSubFolder As MAPIFolder
On Error Resume Next
Num = Num + SubFolder.Folders.Count
For Each xSubFolder In SubFolder.Folders
    Call ProcessFolders(xSubFolder, Num)
Next
End Sub

3. Pritisnite F5 tipko za zagon kode.

4. Na odprtju Izberite mapo pogovornem oknu izberite mapo, katere podmape boste prešteli, in nato kliknite OK . Oglejte si posnetek zaslona:

5. Nato a Kutools za Outlook se prikaže pogovorno okno, ki vam pove, koliko podmap obstaja v navedeni mapi. Oglejte si posnetek zaslona:


Sorodni članki:


Najboljša pisarniška orodja za produktivnost

Kutools za Outlook - Več kot 100 zmogljivih funkcij za nadgradnjo vašega Outlooka

🤖 AI poštni pomočnik: Takojšnja profesionalna e-poštna sporočila z umetno inteligenco – z enim klikom do genialnih odgovorov, popoln ton, večjezično znanje. Preoblikujte pošiljanje e-pošte brez napora! ...

📧 Avtomatizacija e-pošte: Odsoten (na voljo za POP in IMAP)  /  Načrtujte pošiljanje e-pošte  /  Samodejna CC/BCC po pravilih pri pošiljanju e-pošte  /  Samodejno naprej (napredna pravila)   /  Samodejno dodaj pozdrav   /  E-poštna sporočila več prejemnikov samodejno razdeli na posamezna sporočila ...

📨 Email upravljanje: Enostaven priklic e-pošte  /  Blokiraj prevarantska e-poštna sporočila glede na teme in druge  /  Izbriši podvojena e-poštna sporočila  /  napredno iskanje  /  Združite mape ...

📁 Priloge ProShrani paket  /  Batch Detach  /  Paketno stiskanje  /  Samodejno shranite   /  Samodejno loči  /  Samodejno stiskanje ...

🌟 Vmesnik Magic: 😊Več lepih in kul emojijev   /  Povečajte Outlookovo produktivnost s pogledi z zavihki  /  Minimizirajte Outlook, namesto da bi ga zaprli ...

???? Čudeži z enim klikom: Odgovori vsem z dohodnimi prilogami  /   E-poštna sporočila proti lažnemu predstavljanju  /  🕘Pokaži pošiljateljev časovni pas ...

👩🏼‍🤝‍👩🏻 Stiki in koledar: Paketno dodajanje stikov iz izbranih e-poštnih sporočil  /  Razdelite skupino stikov na posamezne skupine  /  Odstranite opomnike za rojstni dan ...

Over 100 Lastnosti Čakajte na svoje raziskovanje! Kliknite tukaj, če želite odkriti več.

 

 

Comments (1)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Ich weiß gar nicht, ob ich hier auch Fragen stellen kann zu gefundenen Makros?Also mache ich es einfach mal, ok?
Das Makro zum Ermitteln der Anzahl von Unterordnern habe ich für meinen Zweck, nämlich in Ordnereigenschaften einzustellen, dass alle Elemente im Ordner angezeigt werden sollen im Verzeichnisbaum links in Outlook habe ich jetzt mal so für mich verändert.
Sub PrivateOrdnerAlleMailsAnzeigen()
Dim xRootFolder As Folder
Dim xFolderCount As Long
Dim xFolder As Object
On Error Resume Next

Neu:
Set xRootFolder = Outlook.Application.Session.PickFolder
If TypeName(xRootFolder) = "Nothing" Then Exit Sub
If xRootFolder.Folders.Count < 1 Then
MsgBox "No subfolders under " & Chr(34) & xRootFolder.Name & Chr(34) & ".", vbInformation, "Kutools for Outlook"
Exit Sub
End If
xRootFolder.ShowItemCount = olShowTotalItemCount
For Each xFolder In xRootFolder.Folders
xFolder.ShowItemCount = olShowTotalItemCount
xFolderCount = xFolderCount + 1
Next
MsgBox xFolderCount & " Ordner konfiguriert.", vbInformation, "Anzeigeart Elemente im Ordner"
xFolderCount = 1
GoTo Neu
End Sub


Das funktioniert auch gut aber es fehlt noch etwas, das ich nicht wirklich eingebaut bekomme.
Dabei geht es darum, dass einige Ordner unter dem Ordner, der ausgewählt wird, noch Unterordner haben, die im Ablauf aber nicht mit bearbeitet werden.

Deshalb der Weg jetzt über Goto Neu und dann Neuauswahl der Unterordner und zuletzt mit manuellem Abbrechen beenden.

Wenn mal bitte jemand drüber schauen und eventuell dafür eine automatische Lösung hätte, wäre ich Euch dankbar.

Gruß Wolfgang
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations