Outlook-Workshop - Ordner löschen - Teil 2

Im vorherigen Teil haben wir einen einzelnen Ordner gelöscht. In diesem Teil lernen wir, wie man Ordner löschen kann. Auch hierbei an kann hier einzelne Konten mit allen darin enthaltenen Ordner, einzelne Ordner eines Kontos oder auch alle Konten mit allen Ordnern behandeln.

Zuerst müss man eine Lieste mit alle Ordnernamen anlegen. Hierzu nutzen wir eine Textdatei. In dieser Textdatei stehen die Namen der Ordner untereinander, ohne Trennzeichen. Die Datei nennen wir OlFolderNames und speichern sie im persönlichen Ordner "Dokumente".

Beispielinhalt der Textdatei:

Test
Test1
Test2
Test3
Test4
Test5
Test6
Test7
Test8
Test9

Damit wir den Inhalt der Textdatei später nutzen können, benötigen wir eine Funktion, welche den Inhalt der Textdatei ausliest und zur späteren Verarbeitung bereitstellt.

Fügen Sie ein neues Modul ein und in dieses die folgende Funktion. Die Funktion müssen Sie nur anpassen, wenn Sie den Namen der Textdatei und dessen Pfad ändern möchten.

Option Private Module
Option Explicit

Public Function ReadNames()
Dim iInt      As Long
Dim TextIn    As String
Dim TextArr   As Variant
Dim ReadFile  As String
Dim txtLines  As Long

ReadFile = Environ("USERPROFILE") & "\Documents\OlFolderNames.txt"

Close #1

Open ReadFile For Input As #1
     txtLines = 0
        Do While Not EOF(1)
           Input #1, TextIn
           txtLines = txtLines + 1
        Loop
Close #1

Open ReadFile For Input As #1
     Redim TextArr(txtLines)
       For iInt = 1 To txtLines
           Input #1, TextArr(iInt)
       Next iInt
Close #1
    
For iInt = 0 To Ubound(TextArr)
    If ReadNames = "" Then
       ReadNames = TextArr(iInt)
    Else
       ReadNames = ReadNames & ";" & TextArr(iInt)
    End If
Next iInt

End Function

Als nächstes benötigen wir wieder die aus dem vorhergehenden Teil bekannte Prozedur "OrdnerLoeschen", diese wurde geringfügig angepasst.

Private Sub OrdnerLoeschen(Folders As Outlook.Folders, _
                            ByVal bRecursive As Boolean, strName As String)
'****************************************************************** 
'* RMH Software                                                   * 
'* René Holtz, 88131 Lindau                                       * 
'* http://www.rholtz-office.de                                    * 
'* rene.holtz@rholtz-office.de                                    * 
'* (nach einer Vorlage von Michael Bauer.                         * 
'*  http://www.vboffice.de/) * 
'****************************************************************** 

Dim iInt As Integer
Dim strNames As Variant
Dim olFolders As Outlook.MAPIFolder

strNames = Split(strName, ";")

For Each olFolders In Folders
    Set Application.ActiveExplorer.CurrentFolder = olFolders
     For iInt = 0 To Ubound(strNames)
        If olFolders.Name = strNames(iInt) Then olFolders.Delete
           If bRecursive Then
              If olFolders.Folders.Count Then OrdnerLoeschen olFolders.Folders, _
                                              bRecursive, strName
           End If
     Next iInt
Next olFolders

End Sub

Kommen wir zu den Prozeduren, die das Löschen veranlassen. Diese Prozeduren sind identisch mit den Prozeduren aus dem vorhergehenden Teil, mit Außnahme einer einzigen Codezeile. Der Einfachheit wegen soll hier nur eine Beispielprozedur genannt werden.

Public Sub DeleteInAllOutlookAccounts()
'******************************** 
'* RMH Software                 * 
'* René Holtz, 88131 Lindau     * 
'* http://www.rholtz-office.de  * 
'* rene.holtz@rholtz-office.de  * 
'******************************** 

Dim olOldFolder  As Outlook.MAPIFolder
Dim olApp        As Outlook.Application
Dim olName       As Outlook.Namespace
Dim olFolder     As Outlook.MAPIFolder
Dim intFolder    As Integer
Dim strName      As String

If MsgBox("Sollen die Ordner gelöscht werden?", _
           vbYesNo + vbQuestion, "Löschen?") = vbYes Then

   strName = ReadNames

   Set olOldFolder = Application.ActiveExplorer.CurrentFolder
   Set olApp = Application
   Set olName = olApp.GetNamespace("MAPI")

       For intFolder = 1 To olApp.Session.Accounts.Count
           Set olFolder = olApp.Session.Folders(intFolder)
               OrdnerLoeschen olFolder.Folders, True, strName
               DoEvents
           Set olFolder = Nothing
       Next intFolder

   Set olName = Nothing
   Set olApp = Nothing
   Set Application.ActiveExplorer.CurrentFolder = olOldFolder

End If

End Sub