handtekening script

Status
Niet open voor verdere reacties.

eatsoup

Gebruiker
Lid geworden
16 nov 2009
Berichten
29
Hoi,

Ik heb een probleempje met mijn handtekening script, hij werkt goed tot het moment dat hij het bestand als handtekening moet opslaan. De handtekening is vervolgens leeg (wordt wel opgeslagen), het rare is dat ik Word "visible" heb gezet en de handtekening in word wel correct is... Hieronder mijn code.
Als jullie er uit kunnen komen, zou erg tof zijn:thumb:

Code:
'Script created by XX for XX on 26-10-2010
On Error Resume Next

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

'AD gegevens ophalen
strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strMail = objuser.mail
strCompany = objUser.Company

'Word openen
Set objWord = CreateObject("Word.Application")
objWord.Visible = true
Const END_OF_STORY = 6
Enter = Chr(11)

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

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

'Statische gegevens
strColumn1  = "Bezoekadres" & Enter
strColumn10 = "XX" & Enter & "XX"
strColumn2  = "Postadres" & Enter
strColumn20 = "XX" & Enter & "XX"
strColumn3  = "Telefoon & Fax" & Enter
strColumn30 = "XX" & Enter & "XX"
strColumn4  = "E-mail & Website" & Enter
strColumn40 = "XX" & Enter & "XX"

strLogo = "\\server-02\Install\logo.jpg"

strDisclamer1 = "De informatie verzonden in dit e-mailbericht is vertrouwelijk en uitsluitend bestemd voor de geadresseerde."
strDisclamer2 = "XX staat niet in voor de juiste en volledige overbrenging van de inhoud van een verzonden e- mailbericht, noch voor tijdige ontvangst daarvan."
strDisclamer3 = "XX kan niet garanderen dat een verzonden e- mailbericht vrij is van virussen, noch dat e-mailberichten worden overgebracht zonder inbreuk of tussenkomst van onbevoegde derden."
strDisclamer4 = "Indien bovenstaand e-mailbericht niet aan u is gericht, verzoeken wij u vriendelijk doch dringend het e-mailbericht te retourneren aan de verzender en het origineel en eventuele kopieën te verwijderen en te vernietigen."

'Gegevens voor tabel
With objSelection
			.Font.Size = "8"
			.Font.Name = "Verdana"
			.Font.Color = RGB(128,128,128)	
	.TypeText "Groet,"
	.TypeText Enter
	.TypeText strName
	.TypeText Enter
	objSelection.InlineShapes.AddPicture(strlogo)
	.TypeText Enter
	.Font.Bold = true
	.TypeText strName
	.TypeText Enter
	.TypeText strTitle
	.Font.Bold = false
	.TypeText Enter
	.TypeText strCompany
	.TypeText Enter
	.TypeText strMail
	.TypeParagraph
	.TypeText strDepartment
	.TypeParagraph
End With

'Tabel tekenen 1x4
objRange.Collapse 0
objDoc.Tables.Add objRange, 1, 4
Set objTable = objDoc.Tables(1)

	objTable.Cell(1, 1).select
 		With objSelection
			.Font.Bold = true
			.TypeText strColumn1
			.Font.Bold = false
			.TypeText strColumn10
		End With
		
	objTable.Cell(1, 2).select
 		With objSelection
			.Font.Bold = true
			.TypeText strColumn2
			.Font.Bold = false
			.TypeText strColumn20
		End With
		
	objTable.Cell(1, 3).select
 		With objSelection
			.Font.Bold = true
			.TypeText strColumn3
			.Font.Bold = false
			.TypeText strColumn30
		End With
		
	objTable.Cell(1, 4).select
 		With objSelection
			.Font.Bold = true
			.TypeText strColumn4
			.Font.Bold = false
			.TypeText strColumn40
		End With
'	objSelection.EndKey END_OF_STORY

'Disclamer
With objSelection
			.Font.Size = "6"
			.Font.Name = "Verdana"
			.Font.Color = RGB(128,128,128)
	.TypeText strDisclamer1
	.TypeText strDisclamer2
	.TypeText strDisclamer3
	.TypeText strDisclamer4
End With

'Invoegen in Outlook
objSignatureEntries.Add "Signature", objRange
objSignatureObject.NewMessageSignature = "Signature"
objSignatureObject.ReplyMessageSignature = "Signature"

objDoc.Saved = True
objWord.Quit
 
Niemand geen idee waarom dit niet zou werken? het vreemde is dat ik het ook heb getest met een ander scriptje (waar deze op is gebaseerd, en die werkt wel...)
 
Ben er achter gekomen, hij slaat niet het goede op, door op het einde dit toe te voegen werkt het wel.

Set objRange = objDoc.Range()
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan