VBOffice

Ordnerliste aufklappen

Mit diesem Makro expandieren Sie das komplette Ordnerverzeichnis in Outlook.

Zuletzt geändert: 17.03.2017 | Aufrufe: 160.229  | #57
◀ Vorheriges Beispiel Nächstes Beispiel ▶

Inhalt

Reporter Reporter
Mit dem Reporter erstellen Sie Berichte für Ihre Outlook Daten. Mit wenigen Klicks werden Werte aus Aufgaben, Terminen und dem Journal summiert.

Alle Postfächer oder nur das Hauptpostfach

Haben Sie eine umfangreiche Ordnerhierarchie und müssen bei jedem Outlookstart von Hand die ganze Liste aufklappen? Manchmal macht Outlook das selbst - und häufig nicht. Dieses Beispiel öffnet den ganzen Baum beim Start und ist obendrein ein Schauspiel...

In der Prozedur 'ExpandAllFolders' gibt es die Variable 'ExpandDefaultStoreOnly'. In der aktuellen Einstellung (True) wird nur der Persönliche Ordner expandiert. Wenn alle vorhandenen Postfächer (Datendateien, Emailkonten) geöffnet werden sollen, dann setzen Sie die Variable = False.


tip  So fügen Sie Makros in Outlook ein
Private Sub Application_Startup()
  ExpandAllFolders
End Sub

Private Sub ExpandAllFolders()
  On Error Resume Next
  Dim Ns As Outlook.NameSpace
  Dim Folders As Outlook.Folders
  Dim CurrF As Outlook.MAPIFolder
  Dim F As Outlook.MAPIFolder
  Dim ExpandDefaultStoreOnly As Boolean

  ExpandDefaultStoreOnly = True

  Set Ns = Application.GetNamespace("Mapi")
  Set CurrF = Application.ActiveExplorer.CurrentFolder

  If ExpandDefaultStoreOnly = True Then
    Set F = Ns.GetDefaultFolder(olFolderInbox)
    Set F = F.Parent
    Set Folders = F.Folders
    LoopFolders Folders, True

  Else
    LoopFolders Ns.Folders, True
  End If

  DoEvents
  Set Application.ActiveExplorer.CurrentFolder = CurrF
End Sub

Private Sub LoopFolders(Folders As Outlook.Folders, _
  ByVal bRecursive As Boolean _
)
  Dim F As Outlook.MAPIFolder

  For Each F In Folders
    Set Application.ActiveExplorer.CurrentFolder = F
    DoEvents

    If bRecursive Then
      If F.Folders.Count Then
        LoopFolders F.Folders, bRecursive
      End If
    End If
  Next
End Sub
Category-Manager Category-Manager
Mit dem Category-Manager können Sie Outlook Kategorien gruppieren, synchronisieren und filtern, neuen Emails automatisch die Kategorie des Absenders zuweisen und vieles mehr. Das Addin ist auch für IMAP geeignet.

Einzelne Postfächer ausschließen

Dieses Beispiel ist ähnlich dem ersten. Es werden alle Postfächer und dessen Unterordner geöffnet. Sie können aber einzelne Postfächer ausschließen. Tragen Sie dafür in der Prozedur 'ExpandAllFolders' den Namen des obersten Ordners des auszuschließenden Postfaches für die Variable 'Name' ein. (Im Beispiel wird die Datendatei 'Persönliche Ordner' übersprungen.) Wenn Sie mehrere Postfächer, Emailkonten oder Datendateien überspringen wollen, dann kopieren Sie einfach die ganze Zeile und passen wieder den Namen an.

Und wenn Sie unsicher sind, wie der oberste Ordner heißt, dann lassen Sie das Makro einmal ohne zu überspringende Ordner durchlaufen (kommentieren Sie die entsprechende Zeile mit dem Ordnernamen aus). Im Direktfenster (strg+g) druckt das Makro die Namen der kompletten Ordnerhierarchie.

Private m_SkipThisFolder As VBA.Collection

Private Sub Application_Startup()
  ExpandAllFolders
End Sub

Private Sub ExpandAllFolders()
  On Error Resume Next
  Dim Ns As Outlook.NameSpace
  Dim Folders As Outlook.Folders
  Dim CurrF As Outlook.MAPIFolder
  Dim F As Outlook.MAPIFolder
  Dim Name As String
  
  Set m_SkipThisFolder = New VBA.Collection
  
  'Diese Ordner überspringen
  Name = "Persönliche Ordner": m_SkipThisFolder.Add Name, Name
  
  Set Ns = Application.GetNamespace("Mapi")
  Set CurrF = Application.ActiveExplorer.CurrentFolder

  LoopFolders Ns.Folders, True, 1

  DoEvents
  Set Application.ActiveExplorer.CurrentFolder = CurrF
End Sub

Private Sub LoopFolders(Folders As Outlook.Folders, _
  ByVal bRecursive As Boolean, _
  ByVal Level As Long _
)
  Dim F As Outlook.MAPIFolder
  Dim Skip As Boolean
  Dim Name As String
  
  For Each F In Folders
    Debug.Print String(Level - 1, "-") & F.Name
    Skip = False
    
    If Level = 1 Then
      On Error Resume Next
      Name = m_SkipThisFolder(F.Name)
      If Err.Number = 0 Then
        Skip = True
      End If
      On Error GoTo 0
    End If
    
    If Skip = False Then
      Set Application.ActiveExplorer.CurrentFolder = F
      DoEvents
  
      If bRecursive Then
        If F.Folders.Count Then
          LoopFolders F.Folders, bRecursive, Level + 1
        End If
      End If
    End If
  Next
End Sub
ReplyAll ReplyAll
Mit diesem Addin für Outlook erhalten Sie in verschiedenen Situationen eine Warnung, bevor Sie auf eine Email versehentlich allen anderen Empfängern antworten.
email  Senden Sie eine Nachricht