Function Outlook_DisableNewOutlookMigration() 'ASU 2024-12-10 verhindern das das neue Outlook verwendet wird
Dim objShell As Object, l_data
Set objShell = CreateObject("WScript.Shell")

l_data = ""
On Error Resume Next
l_data = objShell.RegRead("HKCU\Software\Policies\Microsoft\Office\16.0\Outlook\Preferences\UseNewOutlook")
On Error GoTo err

If l_data <> 0 Then
'Gruppenrichtlinien
objShell.RegWrite "HKCU\Software\Policies\Microsoft\Office\16.0\outlook\Preferences\NewOutlookMigrationUserSetting", 0, "REG_DWORD"
objShell.RegWrite "HKCU\Software\Policies\Microsoft\Office\16.0\Outlook\Preferences\UseNewOutlook", 0, "REG_DWORD"
objShell.RegWrite "HKCU\Software\Policies\Microsoft\Office\16.0\Outlook\Options\General\DoNewOutlookAutoMigration", 0, "REG_DWORD"
objShell.RegWrite "HKCU\Software\Policies\Microsoft\Office\16.0\Outlook\Options\General\HideNewOutlookToggle", 1, "REG_DWORD"

'Einstellung für die aktuelle Sitzung
objShell.RegWrite "HKCU\Software\Microsoft\Office\16.0\outlook\Preferences\NewOutlookMigrationUserSetting", 0, "REG_DWORD"
objShell.RegWrite "HKCU\Software\Microsoft\Office\16.0\Outlook\Preferences\UseNewOutlook", 0, "REG_DWORD"
objShell.RegWrite "HKCU\Software\Microsoft\Office\16.0\Outlook\Options\General\DoNewOutlookAutoMigration", 0, "REG_DWORD"
objShell.RegWrite "HKCU\Software\Microsoft\Office\16.0\Outlook\Options\General\HideNewOutlookToggle", 1, "REG_DWORD"
End If


Exit Function
err:
MsgBox "Problem beim Einstellen der Gruppenrichtlinie für neues Outlook" & vbNewLine & "Fehler:" & err.Description, vbCritical + vbOKOnly, "Outlook Gruppenrichtlinie"
End Function