Programmaticaly set signature in Outlook 2016 with vbScript

Question

I've written a vbscript that gets the user-info from the Active Directory, generates a signature based on html and sets the signature in outlook as a default. This worked fine in Office 2010. But now some users have office 2016 and the script does add the signature in outlook, but i can't seem te get it set as default (or the reply-default).

This is the code i used:

Call SetDefaultSignature("MYSIGNATURE","")

Sub SetDefaultSignature(strSigName, strProfile)
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."

If Not IsOutlookRunning Then
Set objreg = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Windows NT\" & _
"CurrentVersion\Windows " & _
"Messaging Subsystem\Profiles\"
If strProfile = "" Then
objreg.GetStringValue HKEY_CURRENT_USER, _
strKeyPath, "DefaultProfile", strProfile
End If
myArray = StringToByteArray(strSigName, True)

strKeyPath = strKeyPath & strProfile & _
"\9375CFF0413111d3B88A00104B2A6676"
objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, _
arrProfileKeys
For Each subkey In arrProfileKeys
strsubkeypath = strKeyPath & "\" & subkey
objreg.SetBinaryValue HKEY_CURRENT_USER, _
strsubkeypath, "New Signature", myArray
objreg.SetBinaryValue HKEY_CURRENT_USER, _
strsubkeypath, "Reply-Forward Signature", StringToByteArray(None, True)
Next
Else
strMsg = "Please shut down Outlook before " & _
"running this script."

MsgBox strMsg, vbExclamation, "SetDefaultSignature"
End If
End Sub

Function IsOutlookRunning()
strComputer = "."
strQuery = "Select * from Win32_Process " & _
"Where Name = '!Outlook.exe'"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery(strQuery)
For Each objProcess In colProcesses
If UCase(objProcess.Name) = "OUTLOOK.EXE" Then
IsOutlookRunning = True
Else
IsOutlookRunning = False
End If
Next
End Function

Public Function StringToByteArray _
(Data, NeedNullTerminator)
Dim strAll
strAll = StringToHex4(Data)
If NeedNullTerminator Then
strAll = strAll & "0000"
End If
intLen = Len(strAll) \ 2
ReDim arr(intLen - 1)
For i = 1 To Len(strAll) \ 2
arr(i - 1) = CByte _
("&H" & Mid(strAll, (2 * i) - 1, 2))
Next
StringToByteArray = arr
End Function

Public Function StringToHex4(Data)
Dim strAll
For i = 1 To Len(Data)

strChar = Mid(Data, i, 1)
strTemp = Right("00" & Hex(AscW(strChar)), 4)
strAll = strAll & Right(strTemp, 2) & Left(strTemp, 2)
Next
StringToHex4 = strAll

End Function

Can anyone help me to check for the version, and depending on the outcome to set de MYSIGNATURE as default in outlook. Like i said, the piece above does that for all the 2010-users...

Answer 1

I've solved my problem, there was an issue with the path. The code I have (and works) is now the following (Tested for Office 2010 and 2016):

'==========================================================================
' Set Signature As Default
'==========================================================================
Call SetDefaultSignature("NameOfTheSignature", "")

Sub SetDefaultSignature(strSigName, strProfile)
const HKEY_CURRENT_USER = &H80000001
const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."

 Set objreg = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv") 

'Determine path to outlook.exe
strKeyOutlookAppPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\OUTLOOK.EXE"
strOutlookPath = "Path"
objreg.GetStringValue HKEY_LOCAL_MACHINE,strKeyOutlookAppPath,strOutlookPath,strOutlookPathValue

'Verify that the outlook.exe exist and get version information
Set objFSO = CreateObject("Scripting.FileSystemObject") 
If objFSO.FileExists(strOutlookPathValue & "outlook.exe") Then
    strOutlookVersionNumber = objFSO.GetFileVersion(strOutlookPathValue & "outlook.exe")
    strOutlookVersion = Left(strOutlookVersionNumber, inStr(strOutlookVersionNumber, ".0") - 1)
End If

'Set profile Registry path based on Outlook version
If strOutlookVersion >= 15 Then
    strKeyPath = "Software\Microsoft\Office\" & strOutlookVersion & ".0\Outlook\Profiles\"
    strDisableKeyPath = "Software\Microsoft\Office\" & strOutlookVersion & ".0\Common\MailSettings\"
    Else    
    strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\"
    strDisableKeyPath = "Software\Microsoft\Office\" & strOutlookVersion & ".0\Common\MailSettings\"
End If

 If strProfile = "" Then
 objreg.GetStringValue HKEY_CURRENT_USER, _
 strKeyPath, "DefaultProfile", strProfile
 End If

myArray = StringToByteArray(strSigName, True)
strKeyPath = strKeyPath & strProfile & "\9375CFF0413111d3B88A00104B2A6676"
objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrProfileKeys


For Each subkey In arrProfileKeys
    strsubkeypath = strKeyPath & "\" & subkey

    objreg.SetStringValue HKEY_CURRENT_USER, strsubkeypath, "New Signature", strSigName 
    objreg.SetStringValue HKEY_CURRENT_USER, strsubkeypath, "Reply-Forward Signature", "(None)"
Next
End Sub