VBS Outlook 2010 Autosignature and Disable

$ausage$

Hi,

So in work our Domain has now moved to Office 2010 and the glorious ADMX admin templates. (**********'s)

So my script works great and it adds everyone’s signature to the default and all is good.

The only problem is I want to disable the button that allows them to change it.
Sure if refreshes at every login so the changes dont stick but I want the button to be gone.
I have tried VBS but I can’t find a way, I did do it by GPO but it then doesn’t allow the script to even enter a sig so that’s no good.

Just wondering if anyone else is uning a different method.

I have added my script for anyone to use if they so wish. Should work on any version of outlook.


1Love

''''''''''''' Script To Force Standard Active Directory Signature In Outlook '''''''''''''
''''''''''''' Author '''''''''''''



'Option Explicit
On Error Resume Next


Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

Dim objSysInfo, strUser, objUSer, strFname, strLname, strInitial, strTitle, strDepartment, strCompany, strPhone, strMobile, strFax, strWeb, strStreet, strCity, strPostcode, objWord, objDoc, objSelection, objEmailOptions, objSignatureobjects, objSignatureEntries, blnWeOpenedWord

strFname = objUser.FirstName
strLname = objUser.LastName
strInitial = objUser.Initials
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company 
strPhone = objUser.telephoneNumber
strMobile = objUser.mobile
strFax = objUser.facsimileTelephoneNumber
strWeb = objUser.wWWHomePage
strStreet = objUser.streetAddress
strCity = objUser.l
StrPostcode = objUser.postalCode
If strPhone = "" Then 
strPhone = "switchboard number"
End If



Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then 
    Set objWord = CreateObject("Word.Application")
    blnWeOpenedWord = True 
End If 
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObjects = objWord.EmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObjects.EmailSignatureEntries
objSelection.Style = "No Spacing"
objSelection.Font.Name = "Arial"
objSelection.Font.Size = "9"
objSelection.Font.Color = RGB(33,00,99)

'Name
objselection.Font.Bold = true
'objSelection.TypeText UCase(strFname) & " "
objSelection.TypeText (strFname) & " "
if strInitial then objSelection.TypeText UCase(strInitial) & ". "
objSelection.TypeText (strLname) & Chr(11)
'objSelection.TypeText UCase(strLname) & Chr(11)
'objselection.Font.Bold = false
objSelection.TypeText strTitle & " - "
objSelection.TypeText strCompany
objSelection.TypeText Chr(11)
objselection.Font.Bold = false

objSelection.Font.Size = "7"
'if strDepartment then 
'objSelection.TypeText strDepartment & Chr(11) 
objSelection.TypeText Chr(11)

'objSelection.TypeText strCompany & Chr(11)

objSelection.TypeText strStreet & Chr(11)

objSelection.TypeText strCity & ", " & StrPostcode & Chr(11)

If strPhone = "" Then 
Else objSelection.TypeText "Phone: " & strPhone & Chr(11)
End If
If strMobile = "" Then
Else objSelection.TypeText "Mobile: " & strMobile & Chr(11)
End If
If strFax = "" Then
Else objSelection.TypeText "Fax: " & strFax & Chr(11)
End If
If strWeb = "" Then
Else objSelection.TypeText "Web: " & strWeb & Chr(11)
End If
If strCompany = "Parent company" Then
objSelection.TypeText "secondary webaddress"
End If


'objSelection.TypeText strConfid
Set objSelection = objDoc.Range()

objSignatureEntries.Add "AD Signature", objSelection
objSignatureObjects.NewMessageSignature = "AD Signature"
objSignatureObjects.ReplyMessageSignature = "AD Signature"

objDoc.Close 0
If blnWeOpenedWord Then
objWord.Quit
End If

I have added my script for anyone to use if they so wish. Should work on any version of outlook.