Here's a possible workaround, from LIsting 17.8 in my book. It probably works only if Word 2007 is installed, because it uses Word's Application.EmailOptions.EmailSignature.EmailSignatureEntries collection. Code is for VBA and gets information from the GAL to fill out the details of the signature. The juicy EmailSignatureEntries part is near the end.
Dim objOL ' As Outlook.Application
Dim objNS ' As Outlook.NameSpace
Dim blnWeStartedOutlook ' As Boolean
Const olFolderInbox = 6
On Error Resume Next
Set objOL = GetObject(, "Outlook.Application")
If objOL Is Nothing Then
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
objNS.Logon "", "", True, True
' objNS.Logon "Outlook Settings", "", False, True
blnWeStartedOutlook = True
Else
Set objNS = objOL.GetNamespace("MAPI")
objNS.Logon "", "", False, False
End If
If Not objNS.GetDefaultFolder(olFolderInbox) Is Nothing Then
Call CreateSignature(objNS)
Else
MsgBox "Could not start Outlook to set up signature"
End If
If blnWeStartedOutlook Then
objNS.Logoff
objOL.Quit
End If
Set objOL = Nothing
Set objNS = Nothing
Sub CreateSignature(objNS)
Dim objMsg ' As Outlook.MailItem
Dim objDoc ' As Word.Document
Dim objSel ' As Word.Selection
Dim objSig ' As Word.EmailSignature
Dim colSig ' As Word.EmailSignatureEntries
Dim objExUser ' As Outlook.ExchangeUser
Dim objUser ' As Outlook.AddressEntry
Dim strSig ' As String
Dim objInsp ' As Outlook.Inspector
Const olmailitem = 0
Const wdCollapseEnd = 0
Const wdStory = 6
Const olDiscard = 1
Const olMinimized = 1
Set objUser = objNS.CurrentUser.AddressEntry
Set objMsg = objNS.Application.CreateItem(olmailitem)
objMsg.Display
Set objInsp = objMsg.GetInspector
objInsp.WindowState = olMinimized
Set objDoc = objInsp.WordEditor
Set objSel = objDoc.Application.Selection
With objSel
.Move wdStory, -1
.InsertAfter "--" & vbCrLf & Space(3)
.Collapse wdCollapseEnd
.InsertAfter objUser.Name
.Font.Bold = True
.InsertAfter " "
.Collapse wdCollapseEnd
End With
If objUser.AddressEntryUserType = _
olExchangeUserAddressEntry Then
Set objExUser = objUser.GetExchangeUser
If objExUser.Department <> "" Then
strSig = vbCrLf & Space(3) & objExUser.Department
End If
If objExUser.CompanyName <> "" Then
strSig = strSig & vbCrLf & Space(3) & _
objExUser.CompanyName
End If
If objExUser.BusinessTelephoneNumber <> "" Then
strSig = strSig & vbCrLf & Space(3) & _
objExUser.BusinessTelephoneNumber
End If
With objSel
.InsertAfter objExUser.PrimarySmtpAddress
.Font.Bold = False
objDoc.Hyperlinks.Add objSel.Range, _
"mailto:" & objExUser.PrimarySmtpAddress
.Collapse wdCollapseEnd
.InsertAfter strSig
End With
Else
With objSel
.InsertAfter objUser.Address
.Font.Bold = False
objDoc.Hyperlinks.Add objSel.Range, _
"mailto:" & objUser.Address
.Collapse wdCollapseEnd
End With
End If
objSel.InsertAfter vbCrLf
objSel.MoveStart wdStory, -1
objSel.Font.Color = wdColorBlack
Set objSig = _
objDoc.Application.EmailOptions.EmailSignature
Set colSig = objSig.EmailSignatureEntries
colSig.Add objUser.Name, objSel.Range
objSig.NewMessageSignature = objUser.Name
objSig.ReplyMessageSignature = objUser.Name
objInsp.Close olDiscard
Set objMsg = Nothing
Set objDoc = Nothing
Set objSel = Nothing
Set objSig = Nothing
Set colSig = Nothing
Set objExUser = Nothing
Set objUser = Nothing
Set objInsp = nothing
End Sub
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54
