Gesperrte Anlagen öffnen

Unsichere Anlagen werden von Outlook® rigeros gesperrt. Nur durch einen Eingriff in die Registrierung lassen sich die gewünschten Anhänge öffnen.

Weitere Informationen finden Sie in dem Beitrag Gesperrten Anhänge öffnen. Der nachfolgende Code nimmt Ihnen den Eingriff in die Registrierung ab und ist einfach in der Funktionsweise. Noch einfacher geht es jedoch mit dem Tool AttachmentsManager.

Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden. Den Code bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor).

Für Outlook® 2000, Outlook® 2002, Outlook® 2003, Outlook® 2007 - VB-Skript erforderlich

Option Explicit
 
Public Sub UnlockAttachments()
 
    '=====================================================================
    ' Sperrt, bzw. entsperrt unsichere Anlagen in Outlook
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-07 Version 1.0.0
    ' 2008-11-20 Version 1.0.1
    ' 2008-11-23 Version 1.0.2
    ' 2009-04-29 Version 1.0.3
    '=====================================================================
 
    Dim objWsh As Object
    Dim strRegKey As String
    Dim strExt As String
 
    Const BOXTITLE As String = "Anlagen (ent)sperren"
 
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Um Daten aus der Registrierung zu lesen bzw. in sie zu schreiben
    '---------------------------------------------------------------------
    Set objWsh = CreateObject("WScript.Shell")
 
    '---------------------------------------------------------------------
    ' Schlüssel zusammenstellen
    '---------------------------------------------------------------------
    strRegKey = "HKCU\Software\Microsoft\Office\%.0\Outlook\Security\Level1Remove"
 
    '---------------------------------------------------------------------
    ' Der Schlüssel ist abhängig von der Outlook-Version
    '---------------------------------------------------------------------
    Select Case Left(Outlook.Version, 2)
        Case "9.": strRegKey = Replace(strRegKey, "%", "9")
        Case "10": strRegKey = Replace(strRegKey, "%", "10")
        Case "11": strRegKey = Replace(strRegKey, "%", "11")
        Case "12": strRegKey = Replace(strRegKey, "%", "12")
        Case "14": strRegKey = Replace(strRegKey, "%", "14")
        Case Else
            MsgBox "Kann Outlook-Version nicht bestimmen.", vbCritical + _
                vbOKOnly, BOXTITLE
            Exit Sub
    End Select
 
    '---------------------------------------------------------------------
    ' Freigeschaltete Dateiendungen aus der Registrierung auslesen
    '---------------------------------------------------------------------
    strExt = objWsh.RegRead(strRegKey)
 
    '---------------------------------------------------------------------
    ' Dateiendungen zur Bearbeitung in Eingabedialog anbieten
    '---------------------------------------------------------------------
    strExt = InputBox("Bitte zum Entsperren von Anlagen deren Dateiendung" & _
            " angeben (z. B. exe;pst;bas;bat):" & vbCrLf & vbCrLf & _
            "Um alle Anlagen zu sperren, geben Sie bitte" & vbCrLf & _
            """lock"" ein. Um alle zu entsperren bitte ""unlock"".", _
            BOXTITLE, strExt)
 
    '---------------------------------------------------------------------
    ' Abbruch?
    '---------------------------------------------------------------------
    If Trim(strExt) = "" Then GoTo ExitProc
 
    '---------------------------------------------------------------------
    ' Anlagen freischalten bzw. sperren
    '---------------------------------------------------------------------
    If LCase(strExt) = "lock" Then
 
        '-----------------------------------------------------------------
        ' Eintrag aus der Registrierung entfernen -> Analgen werden wieder
        ' gesperrt.
        '-----------------------------------------------------------------
        Call objWsh.RegWrite(strRegKey, "")
 
        '-----------------------------------------------------------------
        ' Benutzer informieren
        '-----------------------------------------------------------------
        MsgBox "Alle Anlagen wurden gesperrt." & vbCrLf & vbCrLf & _
            "Die Änderung wird erst nach einem Neustart von Outlook wirksam.", _
            vbInformation + vbOKOnly, BOXTITLE
 
    ElseIf LCase(strExt) = "unlock" Then
 
        '-----------------------------------------------------------------
        ' Alle Dateitypen verwenden
        '-----------------------------------------------------------------
        strExt = "ade;adp;app;asp;bas;bat;cer;chm;cmd;cnt;com;cpl;crt;csh;exe;" & _
            "fxp;hlp;hta;hpj;inf;ins;isp;its;js;jse;ksh;lnk;mad;maf;mag;mam;maq;" & _
            "mar;mas;mat;mau;mav;maw;mda;mdb;mde;mdt;mdw;mdz;msc;msi;msp;mst;" & _
            "osd;ops;pcd;pif;prf;prg;pst;reg;scf;scr;sct;shb;shs;tmp;url;vb;vbe;" & _
            "vbs;vbp;vsmacros;vss;vst;vsw;ws;wsc;wsf;wsh"
 
        '-----------------------------------------------------------------
        ' Alle Anlagen freischalten
        '-----------------------------------------------------------------
        Call objWsh.RegWrite(strRegKey, strExt)
 
        '-----------------------------------------------------------------
        ' Um im folgenden Hinweis besser gelesen zu werden, werden Leer-
        ' zeichen eingefügt.
        '-----------------------------------------------------------------
        strExt = Replace(strExt, ";", "; ")
 
        '-----------------------------------------------------------------
        ' Benutzer informieren
        '-----------------------------------------------------------------
        MsgBox "Alle Anlagen wurden entsperrt:" & vbCrLf & vbCrLf & strExt & _
            vbCrLf & vbCrLf & _
            "Die Änderung wird erst nach einem Neustart von Outlook wirksam.", _
            vbInformation + vbOKOnly, BOXTITLE
 
    Else
 
        '-----------------------------------------------------------------
        ' Gewünschte Anlagen freischalten
        '-----------------------------------------------------------------
        Call objWsh.RegWrite(strRegKey, strExt)
 
        '-----------------------------------------------------------------
        ' Benutzer informieren
        '-----------------------------------------------------------------
        MsgBox "Folgende Anlagen wurden entsperrt: " & strExt & vbCrLf & vbCrLf & _
            "Die Änderung wird erst nach einem Neustart von Outlook wirksam.", _
            vbInformation + vbOKOnly, BOXTITLE
 
    End If
 
ExitProc:
 
    '---------------------------------------------------------------------
    ' Clean Up
    '---------------------------------------------------------------------
    Set objWsh = Nothing
 
End Sub