VBOffice

Ordnerliste aufklappen

Mit diesem Makro expandieren Sie das komplette Ordnerverzeichnis in Outlook.

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

Inhalt

OLKeeper OLKeeper
Der OLKeeper verhindert zuverlässig, dass Sie Microsoft Outlook unbeabsichtigt schließen und so etwa wichtige Emails verpassen würden.

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
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.

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
SAM SAM
Legen Sie fest, mit welcher "Identität" Ihre Emails beim Empfänger erscheinen sollen. Mit SAM bestimmen Sie den Absender und Speicherort für Emails anhand von Regeln.
email  Senden Sie eine Nachricht