Replace or Remove character info pulled from AD to create outlook signature

• Wednesday, June 27, 2012 7:48 AM

   

   
  

  0

  Hello,<o:p></o:p>

  Hope
  someone can help me I been all over trying to figure this out. What I am trying
  to do is replace/remove for example Telephone pulled from AD into the script
  below.<o:p></o:p>

  Pulled:
  1(555)555-5555*<o:p></o:p>

  Once the
  info is pulled from AD in order to create the outlook signatures I need to
  remove the "*" from the AD data pulled. <o:p></o:p>

  So it looks
  like: Pulled: 1(555)555-5555<o:p></o:p>

  The section
  in questions is:<o:p></o:p>

  *************************************************
  

  objTable.Cell(5, 1).Range.Text = "Tel: " & strPhone 
  objTable.Cell(6, 1).Range.Text = "Mobile: " & strMobile
  objTable.Cell(7, 1).Range.Text = "Fax: " & strFax

  <o:p></o:p>

  *************************************************<o:p></o:p>

  This is the
  full script below when a user logs into the domain at their workstation it’s
  executed.<o:p></o:p>

  *************************************************
  

  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 = "Arial"
  objSelection.Font.Size = 10
  objselection.Font.Bold = false
  objSelection.Font.Color = RGB (000,000,000)
   
  'objSelection.TypeParagraph()
   
  'objselection.typetext ""
  '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("\\filer2\users\sig\****.gif")
   
   
  ElseIf (objUser.Department = "COMPANY NAME") Then
          objSelection.InlineShapes.AddPicture("\\filer2\users\sig\****.gif")
   
  Else
          objSelection.InlineShapes.AddPicture("\\filer2\users\sig\****.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 = strGiven & " " & strSurname
    objTable.Cell(2, 1).Range.Text = strTitle
    objTable.Cell(3, 1).Range.Text = strAddress1
    objTable.Cell(4, 1).Range.Text = strAddress2 & ", " & strAddress3 & " " & strPostcode
    
  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 = strAddress2
   
  End If

  objTable.Cell(5, 1).Range.Text = "Tel: " & strPhone 
  objTable.Cell(6, 1).Range.Text = "Mobile: " & strMobile
  objTable.Cell(7, 1).Range.Text = "Fax: " & strFax
   
  '### Makes a clickable mailto: email address based on the users AD information.
   
  Set objCell = objTable.Cell(8, 1)
  Set objCellRange = objCell.Range
  objCell.Select
  objselection.typeText strEmailTEXT
  Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " & strEmail, , , strEmail)
    objLink.Range.Font.Name = "Arial"
    objLink.Range.Font.Size = 10
    objLink.Range.Font.Bold = false
   
  '### Makes a clickable hyperlink.
   
  Set objCell = objTable.Cell(9, 1)
  Set objCellRange = objCell.Range
  objCell.Select
  objSelection.TypeText "Web: "
  Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "http://www.****.org", , , "www.****.org")
    objLink.Range.Font.Name = "Arial"
    objLink.Range.Font.Size = 10
    objLink.Range.Font.Bold = false
    objSelection.Font.Color = RGB (000,045,154) 
   
  objTable.AutoFitBehavior(1)
   
  objSelection.EndKey END_OF_STORY

   
  ' ########### 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

  *************************************************

  please let me know if you have any additiona questions. i am sure its going to be something simple i am just drawing a blank.

  thanks in advance

  • Reply
  • Quote