Outlook 2013: Message Preview - Einstellungen verteilen

On Error Resume Next
Const HKCU = &H80000001
'Check if an outlook 2013 profile exists  
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")  
objReg.EnumKey HKCU, "Software\Microsoft\Office\15.0\Outlook\Profiles", arrSubKeys  
if IsNull(arrSubKeys) then wscript.Quit	'quit if no profile exists  

'Create additional objects  
Set objOL = CreateObject("Outlook.Application")  
Set XML = CreateObject("Msxml2.DOMDocument.6.0")  
XML.async = false

'get views object  
Set ol_views = objOL.GetNamespace("MAPI").GetDefaultFolder(6).Views  
'for each view change preview-style to gray  
For Each v In ol_views
    XML.LoadXML (v.XML)
    Set Node = XML.SelectSingleNode("/view/previewstyle")  
    If Not Node Is Nothing Then
        Node.Text = "color:gray"  
    Else
        Set el = XML.createElement("previewstyle")  
        el.Text = "color:gray"  
        XML.DocumentElement.appendChild (el)
    End If
    v.XML = XML.XML
    v.Save
Next
'Cleanup  
Set XML = Nothing
Set objOL = Nothing

On Error Resume Next
Const HKCU = &H80000001
Set objShell = CreateObject("Wscript.Shell")  
'Check if profile exists  
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")  
objReg.EnumKey HKCU, "Software\Microsoft\Office\15.0\Outlook\Profiles", arrSubKeys  
if IsNull(arrSubKeys) then wscript.Quit	'quit if no profile exists  

'Create additional objects  
Set objOL = CreateObject("Outlook.Application")  
Set XML = CreateObject("Msxml2.DOMDocument.6.0")  
xml.async = False

'Set Start folder to root of default store  
Set folderStart = objOL.Session.DefaultStore.GetRootFolder
'start parsing folderstructure  
parseFolder folderStart

'cleanup  
Set XML = Nothing
Set objOL = Nothing

'sub to parse folder structure recursive  
Sub parseFolder(fldr)
    If fldr.DefaultItemType = 0 Then
        Set v = fldr.CurrentView
        XML.LoadXML (v.XML)
        Set Node = XML.SelectSingleNode("/view/previewstyle")  
        If Not Node Is Nothing Then
            Node.Text = "color:gray"  
        Else
            Set el = XML.createElement("previewstyle")  
            el.Text = "color:gray"  
            XML.DocumentElement.appendChild (el)
        End If
        v.XML = XML.XML
        v.Save
    End If
    For Each subfolder In fldr.Folders
        parseFolder subfolder
    Next
End Sub