jrcarvalho
IS-IT--Management
Hello!
I'm trying to deploy a signature for Outlook using the VBscript below that I've found. It copies the files needed and retrieves the AD info for the user. I've managed to make it work (change the name and path needed in the code), but it shows the error: 800A0005 Runtime error on line 151 car 5:
'objFile.WriteLine fileText
Can someone help? Thanks!!
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
Const ForReading = 1
Const ForWriting = 2
Const HKEY_CURRENT_USER = &H80000001
' This is where the script will store its registry settings
Const KeyPath = "Software\Your Company Name\Outlook Signature"
' The source to your signature files for Outlook, ex: "\\foobar.com\netlogon\sig_files\"
Const SIG_SOURCE = "\\foobar.com\netlogon\sig_files\"
' The version constant can be incremented to push out new versions of the signature files
Const Version = "2.0.4"
Dim arrLocalData 'As String
Dim boolForce 'As Boolean
Dim boolDisplay 'As Boolean
' find out if the signature should be forced or just installed
If Wscript.Arguments.Count <> 0 Then
strArg = LCase(Wscript.Arguments.Item(0))
Select Case strArg
Case "/force"
boolForce = True
call Main()
Case "/force:start"
If forceSignature() = True Then
call setValue(KeyPath, "SignatureForced", "True")
MsgBox "The signature file is now forced. The user cannot change the signature.", ,"Your Company Name Signature"
Else
MsgBox "Could not modify the registry. The signature must be manually selected in Outlook.", ,"Your Company Name Signature"
End If
Wscript.Quit
Case "/force:stop"
boolRemoved = removeForce()
If boolRemoved = True Then
call setValue(KeyPath, "SignatureForced", "False")
MsgBox "The signature file is no longer forced. You must manually select it in Outlook.", ,"Your Company Name Signature"
Else
MsgBox "Could not modify the registry. The signature is still forced.", ,"Your Company Name Signature"
End If
Wscript.Quit
Case "/?"
call displayHelp()
Wscript.Quit
Case "/display"
boolDisplay = True
call Main()
Case Else
boolForce = False
call Main()
End Select
Else
boolForce = False
call Main()
End If
Sub Main()
' start processing
localVersion = readValue("Version")
If IsNull(localVersion) or localVersion <> Version Then
boolReg = addRegistry()
If boolReg = False Then
Wscript.Quit
End If
End If
arrLocalData = getUserData()
If compareData() = False or localVersion <> Version Then
call createSignature()
If boolForce = True Then
If forceSignature() = True Then
call setValue(KeyPath, "SignatureForced", "True")
Else
call setValue(KeyPath, "SignatureForced", "False")
End If
End If
If boolDisplay = True Then
MsgBox "Your signature has been updated.", ,"Your Company Name Signature"
End If
Wscript.Quit
Else
If boolDisplay = True Then
MsgBox "No changes to your signature were required.", ,"Your Company Name Signature"
End If
Wscript.Quit
End If
End Sub
' creates the signature files; main routine
Sub createSignature()
Dim localSigSource 'As String
localSigSource = readValue("UserSignaturePath")
' check to make sure the signature path exists; if not exit
' if Outlook profile is not configured path doesn't exist
' If you'd like the script to create this path, run the following command instead:
' objFSO.CreateFolder(localSigSource) if it isn't found
If objFSO.FolderExists(localSigSource) = False Then
Set objLog = objFSO.CreateTextFile("C:\signature_error.log", True)
objLog.Write "Could not find Local Signature Path: " & localSigSource & " - Installation aborted." & vbCrLf & _
"To resolve this issue open Outlook and click on Tools > Mail Format > Signatures. Then rerun the script."
objLog.Close
Wscript.Quit
End If
objFSO.CopyFolder SIG_SOURCE & "YourCompanyName_files", localSigSource & "YourCompanyName_files", True
call modifyFile(SIG_SOURCE & "YourCompanyName.htm", localSigSource & "YourCompanyName.htm")
call modifyFile(SIG_SOURCE & "YourCompanyName.rtf", localSigSource & "YourCompanyName.rtf")
call modifyFile(SIG_SOURCE & "YourCompanyName.txt", localSigSource & "YourCompanyName.txt")
call setValue(KeyPath, "UserDisplayName", arrLocalData(0))
call setValue(KeyPath, "UserTitle", arrLocalData(1))
call setValue(KeyPath, "UserTel", arrLocalData(2))
call setValue(KeyPath, "UserEmail", arrLocalData(3))
End Sub
' modifies the file passed to it
Sub modifyFile(source, destination)
Dim fileText 'As String
Set objFile = objFSO.OpenTextFile(source, forReading)
fileText = objFile.ReadAll
objFile.Close
fileText = Replace(fileText, "%USERNAME%", arrLocalData(0))
fileText = Replace(fileText, "%TITLE%", arrLocalData(1))
fileText = Replace(fileText, "%TELEPHONE%", arrLocalData(2))
fileText = Replace(fileText, "%EMAIL%", arrLocalData(3))
Set objFile = objFSO.CreateTextFile(destination, True)
objFile.WriteLine fileText
objFile.Close
End Sub
' compares the current data with the data from the directory; returns a boolean result
Function compareData()
Dim title, tel, email, name 'As String
name = readValue("UserDisplayName")
title = readValue("UserTitle")
tel = readValue("UserTel")
email = readValue("UserEmail")
If arrLocalData(0) <> name or arrLocalData(1) <> title or arrLocalData(2) <> tel or arrLocalData(3) <> email Then
compareData = False
Else
compareData = True
End If
End Function
' gets the current user's AD fields, returns as an array
Function getUserData()
Set objSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
Dim arrUserData(3) 'As String
arrUserData(0) = objUser.DisplayName
arrUserData(1) = objUser.Title
arrUserData(2) = objUser.TelephoneNumber
arrUserData(3) = Lcase(objUser.Mail)
getUserData = arrUserData
End Function
' add the registry keys if needed, modify them if they exist
' returns boolean result
Function addRegistry()
On Error Resume Next
Dim valueName 'As String
Dim svValue 'As String
Dim keyCreated 'As Boolean
Dim dwCreated 'As Boolean
addRegistry = False
objReg.CreateKey HKEY_CURRENT_USER, KeyPath
sigValue = setValue(KeyPath, "SignatureForced", "")
titleValue = setValue(KeyPath, "UserTitle", "")
telValue = setValue(KeyPath, "UserTel", "")
emailValue = setValue(KeyPath, "UserEmail", "")
newVersion = setValue(KeyPath, "Version", Version)
displayName = setValue(KeyPath, "UserDisplayName", "")
sigPath = setValue(KeyPath, "UserSignaturePath", objShell.SpecialFolders("AppData") & "\Microsoft\Signatures\")
If titleValue = 0 and telValue = 0 and emailValue = 0 and newVersion = 0 and sigPath = 0 and displayName = 0 Then
addRegistry = True
End If
End Function
' forces the signature; the user cannot change it; returns boolean result
' make sure that the YourCompanyName is the same as the Signature file name without the extension
' ex: MyCompany.htm would be MyCompany
Function forceSignature()
Dim officeKeyPath 'As String
officeKeyPath = "Software\Microsoft\Office\12.0\Common\MailSettings"
newSig = setValue(officeKeyPath, "NewSignature", "YourCompanyName")
replySig = setValue(officeKeyPath, "ReplySignature", "YourCompanyName")
If newSig = 0 and replySig = 0 Then
forceSignature = True
Else
forceSignature = False
End If
End Function
' sets the value of the given string value. returns an error result
Function setValue(currentKeyPath, valueName, svValue)
setValue = objReg.SetStringValue(HKEY_CURRENT_USER, currentKeyPath, valueName, svValue)
End Function
' returns a boolean if it cannot find the file, else returns the string value
Function readValue(valueName)
Dim currentValue 'As String
objReg.GetStringValue HKEY_CURRENT_USER, KeyPath, valueName, currentValue
readValue = currentValue
End Function
' removes the keys which force the signature; returns a boolean result
Function removeForce()
officeKeyPath = "Software\Microsoft\Office\12.0\Common\MailSettings"
deleteNew = objReg.DeleteValue(HKEY_CURRENT_USER, officeKeyPath, "NewSignature")
deleteReply = objReg.DeleteValue(HKEY_CURRENT_USER, officeKeyPath, "ReplySignature")
If deleteNew = 0 and deleteReply = 0 Then
removeForce = True
Else
removeForce = False
End If
End Function
' displays the script usage on the screen
Sub displayHelp()
Dim strHelp 'As String
strHelp = "Sig-Creator v2 Usage" & vbCrLf & vbCrLf & _
"sig-creator.vbs [arg]" & vbCrLf & vbCrLf & _
"[arg] can be one of the following:" & vbCrLf & _
vbTab & "/force" & vbTab & vbTab & "Forces the signature when there are changes made to the users profile." & vbCrLf & _
vbTab & "/force:start" & vbTab & "Forces the signature when the signature is already resident on the user's PC." & vbCrLf & _
vbTab & "/force:stop" & vbTab & "Stops the signature from being forced, allowing the user to change their signature." & vbCrLf & _
vbTab & "/display" & vbTab & vbTab & "Displays a prompt to the user with the final status when the script completes." & vbCrLf & _
vbTab & "/?" & vbTab & vbTab & "Displays this help dialog." & vbCrLf &vbCrLf & _
"The default action is to install the signature files only."
MsgBox strHelp, ,"Your Company Name Signature"
End Sub
I'm trying to deploy a signature for Outlook using the VBscript below that I've found. It copies the files needed and retrieves the AD info for the user. I've managed to make it work (change the name and path needed in the code), but it shows the error: 800A0005 Runtime error on line 151 car 5:
'objFile.WriteLine fileText
Can someone help? Thanks!!
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
Const ForReading = 1
Const ForWriting = 2
Const HKEY_CURRENT_USER = &H80000001
' This is where the script will store its registry settings
Const KeyPath = "Software\Your Company Name\Outlook Signature"
' The source to your signature files for Outlook, ex: "\\foobar.com\netlogon\sig_files\"
Const SIG_SOURCE = "\\foobar.com\netlogon\sig_files\"
' The version constant can be incremented to push out new versions of the signature files
Const Version = "2.0.4"
Dim arrLocalData 'As String
Dim boolForce 'As Boolean
Dim boolDisplay 'As Boolean
' find out if the signature should be forced or just installed
If Wscript.Arguments.Count <> 0 Then
strArg = LCase(Wscript.Arguments.Item(0))
Select Case strArg
Case "/force"
boolForce = True
call Main()
Case "/force:start"
If forceSignature() = True Then
call setValue(KeyPath, "SignatureForced", "True")
MsgBox "The signature file is now forced. The user cannot change the signature.", ,"Your Company Name Signature"
Else
MsgBox "Could not modify the registry. The signature must be manually selected in Outlook.", ,"Your Company Name Signature"
End If
Wscript.Quit
Case "/force:stop"
boolRemoved = removeForce()
If boolRemoved = True Then
call setValue(KeyPath, "SignatureForced", "False")
MsgBox "The signature file is no longer forced. You must manually select it in Outlook.", ,"Your Company Name Signature"
Else
MsgBox "Could not modify the registry. The signature is still forced.", ,"Your Company Name Signature"
End If
Wscript.Quit
Case "/?"
call displayHelp()
Wscript.Quit
Case "/display"
boolDisplay = True
call Main()
Case Else
boolForce = False
call Main()
End Select
Else
boolForce = False
call Main()
End If
Sub Main()
' start processing
localVersion = readValue("Version")
If IsNull(localVersion) or localVersion <> Version Then
boolReg = addRegistry()
If boolReg = False Then
Wscript.Quit
End If
End If
arrLocalData = getUserData()
If compareData() = False or localVersion <> Version Then
call createSignature()
If boolForce = True Then
If forceSignature() = True Then
call setValue(KeyPath, "SignatureForced", "True")
Else
call setValue(KeyPath, "SignatureForced", "False")
End If
End If
If boolDisplay = True Then
MsgBox "Your signature has been updated.", ,"Your Company Name Signature"
End If
Wscript.Quit
Else
If boolDisplay = True Then
MsgBox "No changes to your signature were required.", ,"Your Company Name Signature"
End If
Wscript.Quit
End If
End Sub
' creates the signature files; main routine
Sub createSignature()
Dim localSigSource 'As String
localSigSource = readValue("UserSignaturePath")
' check to make sure the signature path exists; if not exit
' if Outlook profile is not configured path doesn't exist
' If you'd like the script to create this path, run the following command instead:
' objFSO.CreateFolder(localSigSource) if it isn't found
If objFSO.FolderExists(localSigSource) = False Then
Set objLog = objFSO.CreateTextFile("C:\signature_error.log", True)
objLog.Write "Could not find Local Signature Path: " & localSigSource & " - Installation aborted." & vbCrLf & _
"To resolve this issue open Outlook and click on Tools > Mail Format > Signatures. Then rerun the script."
objLog.Close
Wscript.Quit
End If
objFSO.CopyFolder SIG_SOURCE & "YourCompanyName_files", localSigSource & "YourCompanyName_files", True
call modifyFile(SIG_SOURCE & "YourCompanyName.htm", localSigSource & "YourCompanyName.htm")
call modifyFile(SIG_SOURCE & "YourCompanyName.rtf", localSigSource & "YourCompanyName.rtf")
call modifyFile(SIG_SOURCE & "YourCompanyName.txt", localSigSource & "YourCompanyName.txt")
call setValue(KeyPath, "UserDisplayName", arrLocalData(0))
call setValue(KeyPath, "UserTitle", arrLocalData(1))
call setValue(KeyPath, "UserTel", arrLocalData(2))
call setValue(KeyPath, "UserEmail", arrLocalData(3))
End Sub
' modifies the file passed to it
Sub modifyFile(source, destination)
Dim fileText 'As String
Set objFile = objFSO.OpenTextFile(source, forReading)
fileText = objFile.ReadAll
objFile.Close
fileText = Replace(fileText, "%USERNAME%", arrLocalData(0))
fileText = Replace(fileText, "%TITLE%", arrLocalData(1))
fileText = Replace(fileText, "%TELEPHONE%", arrLocalData(2))
fileText = Replace(fileText, "%EMAIL%", arrLocalData(3))
Set objFile = objFSO.CreateTextFile(destination, True)
objFile.WriteLine fileText
objFile.Close
End Sub
' compares the current data with the data from the directory; returns a boolean result
Function compareData()
Dim title, tel, email, name 'As String
name = readValue("UserDisplayName")
title = readValue("UserTitle")
tel = readValue("UserTel")
email = readValue("UserEmail")
If arrLocalData(0) <> name or arrLocalData(1) <> title or arrLocalData(2) <> tel or arrLocalData(3) <> email Then
compareData = False
Else
compareData = True
End If
End Function
' gets the current user's AD fields, returns as an array
Function getUserData()
Set objSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
Dim arrUserData(3) 'As String
arrUserData(0) = objUser.DisplayName
arrUserData(1) = objUser.Title
arrUserData(2) = objUser.TelephoneNumber
arrUserData(3) = Lcase(objUser.Mail)
getUserData = arrUserData
End Function
' add the registry keys if needed, modify them if they exist
' returns boolean result
Function addRegistry()
On Error Resume Next
Dim valueName 'As String
Dim svValue 'As String
Dim keyCreated 'As Boolean
Dim dwCreated 'As Boolean
addRegistry = False
objReg.CreateKey HKEY_CURRENT_USER, KeyPath
sigValue = setValue(KeyPath, "SignatureForced", "")
titleValue = setValue(KeyPath, "UserTitle", "")
telValue = setValue(KeyPath, "UserTel", "")
emailValue = setValue(KeyPath, "UserEmail", "")
newVersion = setValue(KeyPath, "Version", Version)
displayName = setValue(KeyPath, "UserDisplayName", "")
sigPath = setValue(KeyPath, "UserSignaturePath", objShell.SpecialFolders("AppData") & "\Microsoft\Signatures\")
If titleValue = 0 and telValue = 0 and emailValue = 0 and newVersion = 0 and sigPath = 0 and displayName = 0 Then
addRegistry = True
End If
End Function
' forces the signature; the user cannot change it; returns boolean result
' make sure that the YourCompanyName is the same as the Signature file name without the extension
' ex: MyCompany.htm would be MyCompany
Function forceSignature()
Dim officeKeyPath 'As String
officeKeyPath = "Software\Microsoft\Office\12.0\Common\MailSettings"
newSig = setValue(officeKeyPath, "NewSignature", "YourCompanyName")
replySig = setValue(officeKeyPath, "ReplySignature", "YourCompanyName")
If newSig = 0 and replySig = 0 Then
forceSignature = True
Else
forceSignature = False
End If
End Function
' sets the value of the given string value. returns an error result
Function setValue(currentKeyPath, valueName, svValue)
setValue = objReg.SetStringValue(HKEY_CURRENT_USER, currentKeyPath, valueName, svValue)
End Function
' returns a boolean if it cannot find the file, else returns the string value
Function readValue(valueName)
Dim currentValue 'As String
objReg.GetStringValue HKEY_CURRENT_USER, KeyPath, valueName, currentValue
readValue = currentValue
End Function
' removes the keys which force the signature; returns a boolean result
Function removeForce()
officeKeyPath = "Software\Microsoft\Office\12.0\Common\MailSettings"
deleteNew = objReg.DeleteValue(HKEY_CURRENT_USER, officeKeyPath, "NewSignature")
deleteReply = objReg.DeleteValue(HKEY_CURRENT_USER, officeKeyPath, "ReplySignature")
If deleteNew = 0 and deleteReply = 0 Then
removeForce = True
Else
removeForce = False
End If
End Function
' displays the script usage on the screen
Sub displayHelp()
Dim strHelp 'As String
strHelp = "Sig-Creator v2 Usage" & vbCrLf & vbCrLf & _
"sig-creator.vbs [arg]" & vbCrLf & vbCrLf & _
"[arg] can be one of the following:" & vbCrLf & _
vbTab & "/force" & vbTab & vbTab & "Forces the signature when there are changes made to the users profile." & vbCrLf & _
vbTab & "/force:start" & vbTab & "Forces the signature when the signature is already resident on the user's PC." & vbCrLf & _
vbTab & "/force:stop" & vbTab & "Stops the signature from being forced, allowing the user to change their signature." & vbCrLf & _
vbTab & "/display" & vbTab & vbTab & "Displays a prompt to the user with the final status when the script completes." & vbCrLf & _
vbTab & "/?" & vbTab & vbTab & "Displays this help dialog." & vbCrLf &vbCrLf & _
"The default action is to install the signature files only."
MsgBox strHelp, ,"Your Company Name Signature"
End Sub