Loncat ke daftar isi utama

Bagaimana cara membuka semua subfolder dari Outlook?

Pengarang: Xiaoyang Terakhir Dimodifikasi: 2018-11-21

Jika Anda membuat beberapa subfolder di bawah folder Outlook Anda, bagaimana Anda bisa membuka atau memperluas semua subfolder ini dengan segera? Artikel ini, saya akan memperkenalkan kode VBA yang berguna bagi Anda untuk menyelesaikan pekerjaan ini.

Buka atau perluas semua subfolder dari Outlook dengan kode VBA

Buka atau perluas semua subfolder dari Outlook dengan kode VBA

Harap terapkan kode VBA berikut untuk memperluas semua subfolder dari semua akun Outlook:

1. Tahan ALT + F11 kunci untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.

2. Klik Menyisipkan > Modul, dan tempelkan makro berikut di Jendela Modul.

Kode VBA: Buka semua subfolder dari 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. Lalu tekan F5 kunci untuk menjalankan kode ini, dan semua subfolder di semua akun Outlook Anda telah diperluas, lihat tangkapan layar:

doc memperluas subfolder 1

Alat Produktivitas Kantor Terbaik

Kutools untuk Outlook - Lebih dari 100 Fitur Canggih untuk Meningkatkan Outlook Anda

🤖 Asisten Surat AI: Email profesional instan dengan keajaiban AI--satu klik untuk mendapatkan balasan jenius, nada sempurna, penguasaan multibahasa. Ubah email dengan mudah! ...

📧 Email Otomatis: Di Luar Kantor (Tersedia untuk POP dan IMAP)  /  Jadwal Kirim Email  /  Auto CC/BCC Sesuai Aturan Saat Mengirim Email  /  Penerusan Otomatis (Aturan Lanjutan)   /  Tambah Salam Otomatis   /  Secara Otomatis Membagi Email Multi-Penerima menjadi Pesan Individual ...

📨 email Management: Mengingat Email dengan Mudah  /  Blokir Email Penipuan berdasarkan Subjek dan Lainnya  /  Hapus Email Duplikat  /  Pencarian  /  Konsolidasi Folder ...

📁 Lampiran Pro: Penyimpanan Batch  /  Pelepasan Batch  /  Kompres Batch  /  Penyimpanan otomatis   /  Lepaskan Otomatis  /  Kompres Otomatis ...

🌟 Antarmuka Ajaib: 😊Lebih Banyak Emoji Cantik dan Keren   /  Tingkatkan Produktivitas Outlook Anda dengan Tampilan Tab  /  Minimalkan Outlook Daripada Menutup ...

👍 Keajaiban sekali klik: Balas Semua dengan Lampiran Masuk  /   Email Anti-Phishing  /  🕘Tampilkan Zona Waktu Pengirim ...

👩🏼‍🤝‍👩🏻 Kontak & Kalender: Batch Tambahkan Kontak Dari Email yang Dipilih  /  Bagi Grup Kontak menjadi Grup Individual  /  Hapus Pengingat Ulang Tahun ...

Lebih 100 Fitur Tunggu Eksplorasi Anda! Klik Di Sini untuk Menemukan Lebih Banyak.

 

 

Comments (3)
No ratings yet. Be the first to rate!
Sandra
Sandra
This comment was minimized by the moderator on the site
Guten Abend,

habe das o.g. Makro ausgetestet und es funktioniert super, ABER...

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

Vielen Dank!
Reply
0
0
skyyang
skyyang     Sandra
This comment was minimized by the moderator on the site
Hello, Sandra,
To only open the subfolders from a specific folder, please apply the below code:
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

Please try, hope it can help you!
Reply
Report
0
0
Doug Fisher
Doug Fisher
This comment was minimized by the moderator on the site
I have been looking for this answer for a long time! Thank you.
Reply
0
0
There are no comments posted here yet
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations