Hvordan åbner jeg alle undermapper fra Outlook?

Hvis du opretter flere undermapper under dine Outlook-mapper, hvordan kan du straks åbne eller udvide alle disse undermapper? Denne artikel vil jeg introducere en nyttig VBA-kode til dig til at løse dette job.

Åbn eller udvid alle undermapper fra Outlook med VBA-kode

Åbn eller udvid alle undermapper fra Outlook med VBA-kode

Anvend følgende VBA-kode for at udvide alle undermapper fra alle Outlook-konti:

1. Hold nede ALT + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

2. Klik indsatte > Moduler, og indsæt følgende makro i modulvinduet.

VBA-kode: Åbn alle undermapper fra Outlook:

Sub ExpandAllMailFolders()
    Dim xCurrentFolder As Folder
    Dim xAllFolders As Folders
    Dim xFolder As Folder
    On Error Resume Next
    Set xCurrentFolder = Application.ActiveExplorer.CurrentFolder
    Set xAllFolders = Application.Session.Folders
    For Each xFolder In xAllFolders
        Call ProcessFolders(xFolder)
    Next
    Set Application.ActiveExplorer.CurrentFolder = xCurrentFolder
End Sub
Sub ProcessFolders(ByVal CurFolder As Folder)
    Dim xSubfolder As Folder
    On Error Resume Next
    If CurFolder.DefaultItemType <> olMailItem Then Exit Sub
    Set Application.ActiveExplorer.CurrentFolder = CurFolder
    DoEvents
    If CurFolder.Folders.Count = 0 Then Exit Sub
    For Each xSubfolder In CurFolder.Folders
        Call ProcessFolders(xSubfolder)
    Next
End Sub

3. Tryk derefter på F5 nøgle til at køre denne kode, og alle undermapper på alle konti i din Outlook er blevet udvidet, se skærmbillede:

Kutools for Outlook - Bringer 100 avancerede funktioner til Outlook, og gør arbejdet meget lettere!

Auto CC / BCC ved regler, når du sender e-mail; Automatisk videresendelse Flere e-mails efter brugerdefineret; Auto svar uden udvekslingsserver og flere automatiske funktioner ...
BCC Advarsel - vis besked, når du prøver at besvare alle hvis din e-mail-adresse er på BCC-listen; Påmind, når du mangler vedhæftede filer, og mere minder funktioner ...
Svar (alle) med alle vedhæftede filer i mailsamtalen; Besvar mange e-mails på få sekunder Tilføj automatisk hilsen når svar Tilføj dato til emne ...
Vedhæftningsværktøjer: Administrer alle vedhæftede filer i alle mails, Automatisk afmontering, Komprimer alle, Omdøb alt, Gem alle ... Hurtig rapport, Tæl valgte mails...
Kraftige uønskede e-mails efter skik; Fjern duplikerede mails og kontakter... Gør dig i stand til at gøre smartere, hurtigere og bedre i Outlook.

shot kutools outlook kutools fane 1180x121

shot kutools outlook kutools plus fane 1180x121

Læs mere ... Hent nu...

Kommentarer (3)

Ingen vurderinger endnu. Vær den første til at bedømme!

Doug Fisher

omkring 4 år siden

#28582

Denne kommentar blev minimeret af moderatoren på webstedet

Jeg har ledt efter dette svar i lang tid! Tak skal du have.

Svar

Sandra

cirka 6 måneder siden

#41079

Denne kommentar blev minimeret af moderatoren på webstedet

God aften,

have das og Makro ausgetestet und es funktioniert super, ABER...

könnte man auch sagen öffne nur die Unterordner eines bestimmten Hauptordners?
Hvis ja, hvordan?

Tak!

Svar

skyyang Sandra

cirka 6 måneder siden

#41666

Denne kommentar blev minimeret af moderatoren på webstedet

Hej Sandra,
For kun at åbne undermapperne fra en bestemt mappe, skal du anvende nedenstående kode:

Sub ExpandAllMailFolders()
    Dim xCurrentFolder As Folder
    Dim xFolder As Folder
    On Error Resume Next
    Set xCurrentFolder = Application.ActiveExplorer.CurrentFolder
    Set xFolder = Application.Session.PickFolder
    If xFolder Is Nothing Then Exit Sub
    Call ProcessFolders(xFolder)
    Set Application.ActiveExplorer.CurrentFolder = xCurrentFolder
End Sub
Sub ProcessFolders(ByVal CurFolder As Folder)
    Dim xSubfolder As Folder
    On Error Resume Next
    If CurFolder.DefaultItemType <> olMailItem Then Exit Sub
    Set Application.ActiveExplorer.CurrentFolder = CurFolder
    DoEvents
    If CurFolder.Folders.Count = 0 Then Exit Sub
    For Each xSubfolder In CurFolder.Folders
        Call ProcessFolders(xSubfolder)
    Next
End Sub

Prøv venligst, håber det kan hjælpe dig!

Svar

Rapport

Der er endnu ingen kommentarer her