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).
Ab Outlook® 2000 - 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