Outlook’ta tüm klasörlerin ve alt klasörlerinizin listesini nasıl dışa aktarır ve yazdırırsınız?

Genel olarak, Outlook’ta Gezinme bölmesindeki tüm klasörlerin listesini görüntülemek için “Ctrl” + “6” tuşlarına basabilirsiniz. Ancak bu klasör listesini doğrudan yazdıramazsınız. Bu makalede, Outlook’taki tüm klasörleri ve alt klasörleri dışa aktarıp yazdırmak için iki VBA betiği paylaşılıyor.

• Yeni Email içindeki tüm Outlook klasörlerinin ve alt klasörlerinin listesini dışa aktarın ve yazdırın
• Tüm Outlook klasörlerinin ve alt klasörlerinin listesini Notepad'e dışa aktarın ve yazdırın

---

Yeni Email içindeki tüm Outlook klasörlerinin ve alt klasörlerinin listesini dışa aktarın ve yazdırın

Bu yöntem, belirtilen e-posta hesabındaki tüm klasörleri ve alt klasörleri listeleyen bir VBA betiğini kullanarak bu listeyi Outlook’ta yeni bir e-postaya aktarır; böylece klasör yapınızı kolayca yazdırabilirsiniz.

1. Microsoft Visual Basic for Applications penceresini açmak için "Alt" + "F11" tuşlarına basın.

2. "Ekle" > "Modül" seçeneğine tıklayıp aşağıdaki VBA kodunu yeni modül penceresine yapıştırın.

VBA: Outlook'ta bir Yeni Email içindeki klasörlerin ve alt klasörlerin listesini dışa aktarın

Public gFolders As String

Public Sub GetFolderNames()
Dim oSession As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder
Dim oNewMail As Outlook.MailItem

Set oSession = Outlook.Application.GetNamespace("MAPI")
Set oFolder = oSession.PickFolder

If (oFolder Is Nothing) Then Exit Sub

ProcessFolder oFolder

Set oNewMail = Application.CreateItem(olMailItem)
oNewMail.Body = gFolders
oNewMail.Display

gFolders = ""
End Sub

Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
Dim i As Long
Dim oSubFolder As Outlook.MAPIFolder
Dim oFolder As Outlook.MAPIFolder
Dim sFolderPaths As String

For i = CurrentFolder.Folders.Count To 1 Step -1
    Set oFolder = CurrentFolder.Folders(i)
    sFolderPaths = oFolder.FolderPath
    gFolders = gFolders & vbCrLf & sFolderPaths & " " & oFolder.Items.Count
Next

For Each oSubFolder In CurrentFolder.Folders
    If oSubFolder.Name <> "Deleted Items" Then
        ProcessFolder oSubFolder
    End If
Next
End Sub

3. VBA'yı çalıştırmak için F5 tuşuna basın.

4. Açılan Klasör Seç iletişim kutusunda, yazdırmak istediğiniz e-posta hesabını seçin ve “Tamam” düğmesine tıklayın.

5. Seçilen hesabın klasör listesi, aşağıda gösterildiği gibi bir Yeni E-posta içine kopyalanacaktır. Kılavuz listesini yazdırmak için "Dosya" > "Yazdır" seçeneğine tıklayın.

6. Yazdırdıktan sonra Yeni E-posta dosyasını kaydetmeden kapatın.

---

Tüm Outlook klasörlerinin ve alt klasörlerinin listesini Notepad'e dışa aktarın ve yazdırın

Bu yöntem, belirtilen e-posta hesabındaki tüm klasörleri ve alt klasörleri Outlook’tan Notepad’e dışa aktarmak için bir VBA betiği sunar; böylece klasör listesini kolayca yazdırabilirsiniz.

1. Microsoft Visual Basic for Applications penceresini açmak için "Alt" + "F11" tuşlarına basın.

2. "Ekle" > "Modül" seçeneğine tıklayıp aşağıdaki VBA kodunu yeni modül penceresine yapıştırın.

VBA: Tüm Outlook klasörlerinin ve alt klasörlerinin listesini Outlook'tan Notepad'e dışa aktarın

Dim gFileName, gCreateTree, gBase

Public Sub ExportFolderTree()
Dim objOutlook
Dim F, Folders
Dim Result

Set objOutlook = CreateObject("Outlook.Application")
Set F = objOutlook.Session.PickFolder

If Not F Is Nothing Then
    Set Folders = F.Folders
    Result = MsgBox("Do you want to create tree?", vbYesNo + vbDefaultButton2 + vbApplicationModal, "Output Folder Tree")
    If Result = 6 Then
        gCreateTree = True
    Else
        gCreateTree = False
    End If

    gFileName = GetDesktopFolder() & "\Outlook-Folders.txt"
    gBase = Len(F.FolderPath) - Len(Replace(F.FolderPath, "\", "")) + 1

    WriteToATextFile (CreateFolderTree(F.FolderPath, F.Name))
    LoopFolders Folders

    Set F = Nothing
    Set Folders = Nothing
    Set objOutlook = Nothing
End If
End Sub

Private Function GetDesktopFolder()
Dim objShell
Set objShell = CreateObject("WScript.Shell")
GetDesktopFolder = objShell.SpecialFolders("Desktop")
Set objShell = Nothing
End Function

Private Sub LoopFolders(Folders)
Dim F
For Each F In Folders
    WriteToATextFile (CreateFolderTree(F.FolderPath, F.Name))
    LoopFolders F.Folders
Next
End Sub

Private Sub WriteToATextFile(OLKfoldername)
Dim objFSO, objTextFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(gFileName, 8, True)
objTextFile.WriteLine (OLKfoldername)
objTextFile.Close
Set objFSO = Nothing
Set objTextFile = Nothing
End Sub

Private Function CreateFolderTree(OLKfolderpath, OLKfoldername)
If gCreateTree = False Then
    CreateFolderTree = Mid(OLKfolderpath, 3)
Else
    Dim i, x, OLKprefix
    i = Len(OLKfolderpath) - Len(Replace(OLKfolderpath, "\", ""))
    For x = gBase To i
        OLKprefix = OLKprefix & "-"
    Next
    CreateFolderTree = OLKprefix & OLKfoldername
End If
End Function

3. VBA'yı çalıştırmak için "F5" tuşuna basın. Açılan **Klasör Seç** iletişim kutusunda, dışa aktarıp yazdırmak istediğiniz klasör listesini içeren e-posta hesabını seçin ve **Tamam** düğmesine tıklayın.

4. Çıktı Klasör Ağacı iletişim kutusu açılacaktır. Ağaç yapısını çıktıya dahil etmek istiyorsanız “Evet”, istemiyorsanız “Hayır” seçeneğine tıklayın.

Şimdi masaüstünüzde "Outlook-Folders" adında bir Metin dosyası oluşturuldu ve kaydedildi:

5. Yeni Metin dosyasını açmak için çift tıklayın, ardından dışa aktarılan Outlook klasör listesini yazdırmak üzere “Dosya” > “Yazdır” seçeneğine tıklayın.

İlgili Makaleler

Outlook'ta klasör listesi görünümünü göster veya gizle