Dear technet users,
I have edit a script from Scriptcentre. The script generates your outlook signature automaticly it pulls information from the Active Directory. It is all working perfect and the signature is also working perfect the following problem is that i need to add
a image below the signature, but when you click on the image it will open a website. Is this possible in VBS? I have searched for hours, but i can't find it.
Is anyone able to help me or point me in the right direction?
'==========================
'
' ############### Script that creates a standard company signature for all users (in a corporate environment); pulling data from Active Directory - dynamic logo insertion depending on department field if needed.
'
' Original by Severn Dickinson
'
' Big up to Script Centre
'
' 17-01-2011.
'
'===========================
On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
' ########### This section connects to Active Directory as the currently logged on user
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
' ########### This section sets up the variables we want to call in the script (items on the left; whereas the items on the right are the active directory database field names) - ie strVariablename = objuser.ad.databasename
strGiven = objuser.givenName
strSurname = objuser.sn
strAddress1 = objUser.streetaddress
strAddress1EXT = objUser.postofficebox
strAddress2 = objuser.l
strAddress3 = objuser.st
strPostcode = objuser.postalcode
strCountry = objuser.c
strFax = objuser.facsimileTelephoneNumber
strMobile = objuser.mobile
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company
strPhone = objUser.telephoneNumber
strEmail =objuser.mail
strWeb = objuser.wWWHomePage
strNotes = objuser.info
strExt = objuser.ipPhone
strDDI = objuser.homephone
strEmailTEXT = "Email: "
' ########### Sets up word template
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.Style = "No Spacing"
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
' ########### Calls the variables from above section and inserts into word template, also sets initial font typeface, colour etc.
objSelection.Font.Name = "Cambria"
objSelection.Font.Size = 10
objselection.Font.Bold = false
objSelection.Font.Color = RGB (000,000,000)
objSelection.TypeParagraph()
objselection.typetext "Met Vriendelijke groeten (Kind Regards),"
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.TypeText strGiven & " " & strSurname
objSelection.Font.Size = 10
objSelection.TypeText ""
objselection.TypeText strnotes
objselection.TypeText Chr(11)
objSelection.Font.Size = 10
objselection.Font.Bold = false
objSelection.TypeText strTitle & Chr(11)
objselection.TypeText Chr(11)
' ########### Logos insert routine.
If (objUser.Department = "COMPANY NAME.") Then
objSelection.InlineShapes.AddPicture("\\jsddom01\data\image001.gif")
ElseIf (objUser.Department = "COMPANY NAME") Then
objSelection.InlineShapes.AddPicture("\\jsddom01\data\image001.gif")
Else
objSelection.InlineShapes.AddPicture("\\jsddom01\data\image001.gif")
End If
' ############ 1 Column en 1 Row
objselection.TypeText Chr(11)
Const Number_of_rows = 12
Const Number_of_columns = 2
Const END_OF_STORY = 12
objSelection.TypeParagraph()
Set objRange = objSelection.Range
objDoc.Tables.Add objRange, number_of_rows, number_of_columns
Set objTable = objDoc.Tables(1)
If (objUser.postofficebox = "") Then
objTable.Cell(1, 1).Range.Text = strCompany
objTable.Cell(2, 1).Range.Text = strAddress1
objTable.Cell(3, 1).Range.Text = strPostcode
objTable.Cell(4, 1).Range.Text = strAddress2
objTable.Cell(5, 1).Range.Text = strAddress3
Else
objTable.Cell(1, 1).Range.Text = strCompany
objTable.Cell(2, 1).Range.Text = strAddress1
objTable.Cell(3, 1).Range.Text = strAddress1EXT
objTable.Cell(4, 1).Range.Text = strPostcode
objTable.Cell(5, 1).Range.Text = strAddress2
objTable.Cell(6, 1).Range.Text = strAddress3
End If
objTable.Cell(7, 1).Range.Text = "Tel: " & strPhone & " | Ext: " & strExt
objTable.Cell(8, 1).Range.Text = "Fax: " & strFax
objTable.Cell(9, 1).Range.Text = "Mobile: " & strMobile
'### Makes a clickable hyperlink.
Set objCell = objTable.Cell(10, 1)
Set objCellRange = objCell.Range
objCell.Select
objSelection.TypeText "Web: "
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "http://www.website.com", , , "www.website.com")
objLink.Range.Font.Name = "Cambria"
objLink.Range.Font.Size = 10
objLink.Range.Font.Bold = false
objSelection.Font.Color = RGB (000,045,154)
'### Makes a clickable mailto: email address based on the users AD information.
Set objCell = objTable.Cell(11, 1)
Set objCellRange = objCell.Range
objCell.Select
objselection.typeText strEmailTEXT
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " & strEmail, , , strEmail)
objLink.Range.Font.Name = "Cambria"
objLink.Range.Font.Size = 10
objLink.Range.Font.Bold = false
objTable.AutoFitBehavior(1)
objSelection.EndKey END_OF_STORY
'### Clickable Facebook Link
NEED A IMAGE WICH LINKS TO A WEBSITE
' ########### Tells outlook to use this signature for new messages and replys. Signature is called Email Signature.
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Email Signature", objSelection
objSignatureObject.NewMessageSignature = "Email Signature"
objSignatureObject.ReplyMessageSignature = "Email Signature"
objDoc.Saved = True
objWord.Quit
Auto generate outlook Signature VB Script
