OLK-Ordner automatisch löschen

Alternativ zum Löschen des fehleranfälligen OLK-Ordners per Hand, bietet sich die Löschung aller darin befindlichen Anhänge beim Beenden von Outlook® an. Damit ist gewährleistet, dass der Ordner nicht vollläuft und dass auch niemand Ihre Anlagen dort findet.

Wem die Umsetzung dieses Beispiels zu aufwendig ist, der findet diese Funktion kostenlos auch im AttachmentsManager wieder.

Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden. Den Code bitte in das Modul DieseOutlookSitzung kopieren.

Ab Outlook® 2000 - VB-Skript erforderlich

Option Explicit
 
Private Sub Application_Quit()
 
    '=====================================================================
    ' Löscht den Inhalt des OLK-Ordner beim Beenden von Outlook
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-06 Version 1.0.0
    '=====================================================================

    Dim objFSO As Object
    Dim objWsh As Object
    Dim objFolder As Object
    Dim strRegKey As String
    Dim strOLK As String
 
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Um Daten aus der Registrierung zu lesen
    '---------------------------------------------------------------------
    Set objWsh = CreateObject("WScript.Shell")
 
    '---------------------------------------------------------------------
    ' Schlüssel zusammenstellen
    '---------------------------------------------------------------------
    strRegKey = "HKCU\Software\Microsoft\Office\%.0\Outlook\Security\OutlookSecureTempFolder"
 
    '---------------------------------------------------------------------
    ' OLK-Ordner aus der Registrierung auslesen
    '---------------------------------------------------------------------
    Select Case Left(Outlook.Version, 2)
        Case "9.": strOLK = objWsh.RegRead(Replace(strRegKey, "%", "9"))
        Case "10": strOLK = objWsh.RegRead(Replace(strRegKey, "%", "10"))
        Case "11": strOLK = objWsh.RegRead(Replace(strRegKey, "%", "11"))
        Case "12": strOLK = objWsh.RegRead(Replace(strRegKey, "%", "12"))
        Case "14": strOLK = objWsh.RegRead(Replace(strRegKey, "%", "14"))
        Case Else
            MsgBox "Kann Outlook-Version nicht bestimmen.", vbCritical + _
                vbOKOnly, "Delete OLK"
            Exit Sub
    End Select
 
    '---------------------------------------------------------------------
    ' VBA bietet keine komfortable Möglichkeit, um Dateien zu löschen,
    ' daher wird VB-Script verwendet.
    '---------------------------------------------------------------------
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    '---------------------------------------------------------------------
    '  Alle Dateien im OLK-Ordner löschen (True = Löschen erzwingen)
    '---------------------------------------------------------------------
    Call objFSO.DeleteFile(strOLK & "*.*", True)
 
    '---------------------------------------------------------------------
    ' OLK-Ordner refernzieren
    '---------------------------------------------------------------------
    Set objFolder = objFSO.GetFolder(strOLK)
 
    '---------------------------------------------------------------------
    ' Ist etwas übrig geblieben, dann Ordner öffnen
    '---------------------------------------------------------------------
    If objFolder.Files.Count Then Call Shell("explorer.exe " & strOLK)
 
    '---------------------------------------------------------------------
    ' Clean Up
    '---------------------------------------------------------------------
    Set objFolder = Nothing
    Set objFSO = Nothing
    Set objWsh = Nothing
 
End Sub