Outlook signature uit AD

[moppentappers]

Beste mede tweakers,

Ik wil een script maken om op basis van gegevens uit de active directory een handtekening te maken, hiervoor heb ik onderstaande gemaakt op basis van http://community.spicewor...ectory-information?page=1
Probleem is nu echter dat de signature wel werkt in outlook 2010 maar niet in outlook 2003, ik heb echter geen idee waar de fout zit.
Ik hoop dat iemand ziet wat ik fout doe, want ik zie het niet!

code: filename

On Error Resume Next

Set objSysInfo = CreateObject("ADSystemInfo")

Set WshShell = CreateObject("WScript.Shell")

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

strName = objUser.FullName
strTitle = objUser.Title
strCred = objUser.info
strStreet = objUser.StreetAddress
strLocation = objUser.l
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strMobile = objUser.Mobile
strFax = objUser.FacsimileTelephoneNumber
strEmail = objUser.mail
strCompany = objUser.Company

Set objWord = CreateObject("Word.Application")

Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

objSelection.Font.Name = "Arial"
objSelection.Font.Size = "10"
objSelection.Font.Color = RGB(0,0,0)
if (strCred) Then objSelection.TypeText strName & ", " & strCred Else objSelection.TypeText strName
objSelection.TypeText " | "
objSelection.TypeText strTitle
objSelection.TypeText " "
objSelection.TypeText strCompany
objSelection.TypeText Chr(11)
objSelection.Font.Size = "7,5"
objSelection.Font.Color = RGB(128,128,128)
if (strPhone) Then objSelection.TypeText "Tel: " & strPhone
if (strMobile) And (strPhone) Then objSelection.TypeText " | "
if (strMobile) Then objSelection.TypeText "Mob: " & strMobile
objSelection.TypeText Chr(11)
objSelection.TypeText strStreet
objSelection.TypeText ", "
objSelection.TypeText strPostCode
objSelection.TypeText ", "
objSelection.TypeText strLocation
objSelection.TypeText Chr(11)
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " & strEmail, , , strEmail) 
  objLink.Range.Font.Name = "Arial" 
  objLink.Range.Font.Size = "7,5"
  objLink.Range.Font.Bold = false 



Set objSelection = objDoc.Range()

objSignatureEntries.Add "Full Signature", objSelection
objSignatureObject.NewMessageSignature = "Full Signature"

objDoc.Saved = True
objWord.Quit

Set objWord = CreateObject("Word.Application")

Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

objSelection.Font.Name = "Arial"
objSelection.Font.Size = "10"
objSelection.Font.Color = RGB(0,0,0)
if (strCred) Then objSelection.TypeText strName & ", " & strCred Else objSelection.TypeText strName
objSelection.TypeText " | "
objSelection.TypeText strTitle
objSelection.TypeText " "
objSelection.TypeText strCompany
objSelection.TypeText Chr(11)
objSelection.Font.Size = "7,5"
objSelection.Font.Color = RGB(128,128,128)
if (strPhone) Then objSelection.TypeText "Tel: " & strPhone
if (strMobile) And (strPhone) Then objSelection.TypeText " | "
if (strMobile) Then objSelection.TypeText "Mob: " & strMobile
objSelection.TypeText Chr(11)
objSelection.TypeText strStreet
objSelection.TypeText ", "
objSelection.TypeText strPostCode
objSelection.TypeText ", "
objSelection.TypeText strLocation
objSelection.TypeText Chr(11)
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " & strEmail, , , strEmail) 


Set objSelection = objDoc.Range()

objSignatureEntries.Add "Reply Signature", objSelection

objSignatureObject.ReplyMessageSignature = "Reply Signature"

objDoc.Saved = True
objWord.Quit

WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\MailSettings\NewSignature" , "Full Signature"
WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\MailSettings\ReplySignature" , "Reply Signature"

WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\MailSettings\NewSignature" , "Full Signature"
WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\MailSettings\ReplySignature" , "Reply Signature"

WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\MailSettings\NewSignature" , "Full Signature"
WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\MailSettings\ReplySignature" , "Reply Signature"

[RobIII]

Kan iemand even...?
Debuggen mag je zelf doen (Debuggen: Hoe doe ik dat?); 118 regels code dumpen en 't voor je laten oplossen doen we hier niet aan. Maar je bent vast van harte welkom bij de talloze bedrijven die dat voor een kleine vergoeding graag voor je doen Probeer 't desnoods eens in Devschuurder werven? Gebruik Vraag & Aanbod!

Open gerust een nieuw topic als je 't toch zelf wil oplossen, maar hanteer dan wel onze Quickstart. "Het werkt niet" is geen beschrijving van wat er fout gaat en zo zien we, zoals je daar zult lezen, nog wel wat zaken graag terug in je topicstart Als je dat dan doet, post dan enkel relevante(!) delen code; 118 regels code is hier totaal overbodig; om te beginnen (maar dat is nog maar 't topje van de ijsberg, zijn regels 10-20, 32-56, 78-99 al totaal niet relevant voor je probleem).

[ Voor 58% gewijzigd door RobIII op 16-01-2012 14:38 ]

[RobIII]

Toevoeging van topicstarter (per email):

Door het weghalen van de regel On Error Resume Next kwam ik erachter dat het aanroepen van Set objWord = CreateObject("Word.Application") niet goed gaat omdat word niet was geïnstalleerd.

Waarvoor dank