Solved

Automatic Outlook Signatures using AD info for unique signatures for each user

Posted on 2008-10-07
4
335 Views
Last Modified: 2010-08-24
Is there any way possible to do this.  I would like each user to automatically have a signature that includes their Full Name, Department, and Phone Number.  I'd like to pull the data from Active Directory and force each user to have this as their signature.

Is this even possible?  

Outlook 2003 and Exchange 2003 Server

0
Comment
Question by:jamietallman
  • 2
4 Comments
 
LVL 12

Accepted Solution

by:
RobinHuman earned 500 total points
ID: 22664275
0
 
LVL 12

Assisted Solution

by:RobinHuman
RobinHuman earned 500 total points
ID: 22664300
0
 
LVL 1

Author Comment

by:jamietallman
ID: 22672161
I figured it out, I had to use two different scripts I found to do what I wanted.  Here is what I used to build a signature from AD information and then set that signature as the default.



'*************CREATE DEFAULT SIGNATURE*******************
 

Set objUser = CreateObject("WScript.Network")

userName = objUser.UserName

domainName = objUser.UserDomain
 

FUNCTION GetUserDN(BYVAL UN, BYVAL DN)

Set ObjTrans = CreateObject("NameTranslate")

objTrans.init 1, DN

objTrans.set 3, DN & "\" & UN

strUserDN = objTrans.Get(1)

GetUserDN = strUserDN

END FUNCTION
 

Set objLDAPUser = GetObject("LDAP://" & GetUserDN(userName,domainName))
 

'Prepare to create some files

Dim objFSO, objWsh, appDataPath, pathToCopyTo, plainTextFile, plainTextFilePath, richTextFile, richTextFilePath, htmlFile, htmlFilePath

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objWsh = CreateObject("WScript.Shell")

appDataPath = objWsh.ExpandEnvironmentStrings("%APPDATA%")

pathToCopyTo = appDataPath & "\Microsoft\Signatures\"
 

'Lets create the plain text signature

'plainTextFilePath = pathToCopyTo & "Default.txt"

'Set plainTextFile = objFSO.CreateTextFile(plainTextFilePath, TRUE)

'plainTextFile.WriteLine(" ")

'plainTextFile.WriteLine(objLDAPUser.DisplayName)

'plainTextFile.WriteLine(objLDAPUser.title)

'plainTextFile.WriteLine(objLDAPUser.company)

'plainTextFile.WriteLine("t: " & objLDAPUser.telephoneNumber)

'plainTextFile.WriteLine("f: " & objLDAPUser.facsimileTelephoneNumber)

'plainTextFile.WriteLine("e: " & objLDAPUser.mail)

'plainTextFile.Write("w: " & objLDAPUser.wWWHomePage)

'plainTextFile.Close
 

'Now we create the Rich Text signature

'richTextFilePath = pathToCopyTo & "Default.rtf"

'Set richTextFile = objFSO.CreateTextFile(richTextFilePath, TRUE)

'richTextFile.WriteLine("{\rtf1\ansi\ansicpg1252\deff0\deflang2057{\fonttbl{\f0\fswiss\fcharset0Arial;}}")

'richTextFile.WriteLine("\viewkind4\uc1\pard\f0\fs20  \par")

'richTextFile.WriteLine(objLDAPUser.DisplayName & "\par")

'richTextFile.WriteLine(objLDAPUser.title & "\par")

'richTextFile.WriteLine(objLDAPUser.company & "\par")

'richTextFile.WriteLine("t: " & objLDAPUser.telephoneNumber & "\par")

'richTextFile.WriteLine("f: " & objLDAPUser.facsimileTelephoneNumber & "\par")

'richTextFile.WriteLine("e: " & objLDAPUser.mail & "\par")

'richTextFile.WriteLine("w: " & objLDAPUser.wWWHomePage & "\par")

'richTextFile.Write("}")

'richTextFile.Close
 

'And finally, the HTML signature

htmlFilePath = pathToCopyTo & "Default.htm"

Set htmlFile = objFSO.CreateTextFile(htmlFilePath, TRUE)

htmlfile.WriteLine("<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN""""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">")

htmlfile.WriteLine("<html xmlns=""http://www.w3.org/1999/xhtml"" >")

htmlfile.WriteLine("<body>")

htmlfile.WriteLine("<div style=""font-size:10pt;font-family:Arial,'helvetica;"">")

'htmlfile.WriteLine("<div> </div>")

htmlfile.WriteLine("<div><b>" & objLDAPUser.DisplayName & "</b></div>")

htmlfile.WriteLine("<div>" & objLDAPUser.title & "</div>")

htmlfile.WriteLine("<div>" & objLDAPUser.department & "</div>")

htmlfile.WriteLine("<div>" & objLDAPUser.company & "</div>")

htmlfile.WriteLine("<div>" & objLDAPUser.telephoneNumber & "</div>")

'htmlfile.WriteLine("<div>" & objLDAPUser.facsimileTelephoneNumber & "</div>")

htmlfile.WriteLine("<div><a href="" & objLDAPUser.mail & "">" & objLDAPUser.mail & "</a></div>")

htmlfile.WriteLine("<br><div><img src=http://www.labarge.com/images/leftlogo.jpg></div>")

'htmlfile.WriteLine("<div>w: <a href=""http://" & objLDAPUser.wWWHomePage & """>" & objLDAPUser.wWWHomePage & "</a></div>")

htmlfile.WriteLine("</div>")

htmlfile.WriteLine("</body>")

htmlfile.Write("</html>")
 
 

'****************SET DEFAULT SIGNATURE****************************
 

' Use this version to set all accounts

' in the default mail profile

' to use a previously created signature

Call SetDefaultSignature("Default", "")
 

' Use this version (and comment the other) to

' modify a named profile.

'Call SetDefaultSignature _

'  ("Signature Name", "Profile Name")
 

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\"

        ' get default profile name if none specified

        If strProfile = "" Then

            objreg.GetStringValue HKEY_CURRENT_USER, _

              strKeyPath, "DefaultProfile", strProfile

        End If

        ' build array from signature name

        myArray = StringToByteArray(strSigName, True)

        strKeyPath = strKeyPath & strProfile & _

                     "\9375CFF0413111d3B88A00104B2A6676"

        objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, _

                       arrProfileKeys

        For Each subkey In arrProfileKeys

            strsubkeypath = strKeyPath & "\" & subkey

            'On Error Resume Next

            objreg.SetBinaryValue HKEY_CURRENT_USER, _

              strsubkeypath, "New Signature", myArray

            objreg.SetBinaryValue HKEY_CURRENT_USER, _

              strsubkeypath, "Reply-Forward Signature", myArray

        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)

    ' Input: normal text

    ' Output: four-character string for each character,

    '         e.g. "3204" for lower-case Russian B,

    '        "6500" for ASCII e

    ' Output: correct characters

    ' needs to reverse order of bytes from 0432

    Dim strAll

    For i = 1 To Len(Data)

        ' get the four-character hex for each character

        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

Open in new window

0
 
LVL 7

Expert Comment

by:tankergoblin
ID: 33518139
How to install this script.
0

Featured Post

Problems using Powershell and Active Directory?

Managing Active Directory does not always have to be complicated.  If you are spending more time trying instead of doing, then it's time to look at something else. For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Lotus Notes – formerly IBM Notes – is an email client application, while IBM Domino (earlier Lotus Domino) is an email server. The client possesses a set of features that are even more advanced as compared to that of Outlook. Likewise, IBM Domino is…
This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
In this video we show how to create an Accepted Domain in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Mail Flow >> Ac…
In this video we show how to create a mailbox database in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Servers >> Data…

895 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now