|
warpyb1 -> VBS Signature scirpting For Outlook (2/28/2008 10:36:03)
|
Hello every one, I am a bit of Newb when it comes to things like this but heres what Im trying to achieve.
I have a group of companies and users that have signatures made by themselves, I need to get some structure here so I decided to create a script that would look at my AD and pull all the relevant information in to a signature.
Which it does, my issue comes when I am trying to import the company logos in to the signature as the system imports the information fine however it some how shrinks all the picture making them unreadable.
I have searched hi and low for some way of getting VBS to stop shrinking the images but im stuck.. Banging ones head as you might say...
My code is below, I thought that the best way would be to have some sort of routine that would pick the picture up once it had been embedded then reset the picture size back to 100%
But no mater what I try I just cant get the thing to work, I am sure Im half way there but would really appreciate some pointers..
Script below,
'On Error Resume Next
Set objNetwork = CreateObject("WScript.Network")
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
'Declare what Me needs
strTitle = objUser.Title
strName = objUser.FullName
strDepartment = objUser.Department
strCompany = objUser.Company
strPhone = objUser.telephoneNumber
strMail = objUser.mail
strWeb = objUser.wwwhomepage
'Start the word system
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
'Define as an email
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
'Create Structure
objSelection.TypeParagraph()
objSelection.Font.name = "Trebuchet MS"
objSelection.Font.Size = 10
objSelection.Font.Bold = False
'objSelection.Font.Color = "128"
objSelection.TypeText "Kind Regards"
objSelection.TypeParagraph()
objSelection.Font.Size = 5
objSelection.TypeParagraph()
objSelection.Font.Size = 10
objSelection.Font.Bold = True
objSelection.TypeText strName
objSelection.TypeParagraph()
objSelection.Font.Bold = False
objSelection.TypeText strDepartment
objSelection.TypeParagraph()
objSelection.Font.Size = 5
objSelection.TypeParagraph()
objSelection.Font.Size = 9
objSelection.Font.Bold = True
objSelection.TypeText strCompany
objSelection.TypeParagraph()
objSelection.TypeText strPhone
objSelection.TypeParagraph()
objSelection.TypeText strWeb
objSelection.TypeParagraph()
'Now lets add the picture based on strCompany
IF strCompany = "CoolBlue IT Solutions" then
Set objShape = objSelection.InLineShapes.AddPicture("\\server1\audit\signatures\Coolblue_h47.jpg")
TestMick() 'Jus todesnt work where I put this part of the function.
ELSEIF strCompany = "GLPTaylors" then
Set objShape = objSelection.InlineShapes.AddPicture("\\server1\audit\signatures\GLP_h47.jpg")
ELSEIF strCompany = "Basics" then
Set objShape = objSelection.InlineShapes.AddPicture("\\server1\audit\signatures\Basics.jpg")
ELSEIF strCompany = "LNTAviation" then
Set objShape = objSelection.InlineShapes.AddPicture("\\server1\audit\signatures\LNT_Aviation.jpg")
ELSEIF strCompany = "LNTConstruction" then
Set objShape = objSelection.InlineShapes.AddPicture("\\server1\audit\signatures\LNT_Construction.jpg")
ELSEIF strCompany = "TeamLNT" then
Set objShape = objSelection.InlineShapes.AddPicture("\\server1\audit\signatures\Team_lnt.jpg")
ELSEIF strCompany = "Ginetta" then
Set objShape = objSelection.InlineShapes.AddPicture("\\server1\audit\signatures\ginetta.jpg")
ELSE Set objShape = objSelection.InlineShapes.AddPicture("\\server1\audit\signatures\LNT_FallBack.jpg")
END IF
objSelection.TypeParagraph()
'Save things back
Set objSelection = objDoc.Range()
'This is the part that I thought would resize the pictures
Sub TestMick()
Set oInl = InLineShapes
For Each oInl in ActiveDocument.InLineShapes
oInl.Height = oInl.Height = 100
oInl.Width = oInl.Width = 100
Next
End Sub
objSignatureEntries.Add "AD Signature", objSelection
objSignatureObject.NewMessageSignature = "AD Signature"
objSignatureObject.ReplyMessageSignature = "AD Signature"
objDoc.Saved = True
objWord.Quit
|
|
|
|
