?
Solved

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

Posted on 2008-10-07
4
Medium Priority
?
372 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 12

Accepted Solution

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

Assisted Solution

by:RobinHuman
RobinHuman earned 1500 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

Office 365 Training for IT Pros

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

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

A list of top three free exchange EDB viewers that helps the user to extract a mailbox from an unmounted .edb file and get a clear preview of all emails & other items with just a single click on mailboxes.
Outlook for dependable use in a very small business   This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This …
how to add IIS SMTP to handle application/Scanner relays into office 365.
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…
Suggested Courses
Course of the Month15 days, 2 hours left to enroll

771 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