У меня есть VBScript, над которым я работаю, который сгенерирует файл подписи из информации AD. Довольно распространенный сценарий, и я настроил его так, чтобы он отлично работал, за исключением одной вещи.
Я не могу на всю жизнь понять, как заставить файл подписи распознавать телефонные номера как ссылки. Мы используем программное обеспечение для телефонной системы Mitel, и просто щелкнув ссылку в подписи, а не скопировав ее в номеронабиратель, мы получим обновление качества жизни.
РЕДАКТИРОВАТЬ: я по существу хочу VBS эквивалент этого
<a href="tel:+12345678910"><span class=ContactDetail>+12 345 678 910</span></a>
Но я не очень разбираюсь в VBscript
On Error Resume Next
'References
'All objuser.XXXX and there counterparts in AD
'https://ss64.com/vb/syntax-userinfo.html
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
strState = objUser.st
strLocation = objUser.l
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strDirect = objUser.ipPhone
strMobile = objUser.Mobile
strEmail = objUser.mail
strWebsite = objUser.wWWHomePage
strOffice = objUser.physicalDeliveryOfficeName
'Creates word application for formatting
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
'Signature Font
objSelection.Font.Name = "Verdana"
objSelection.Font.Size = 10 'Carries over unless specified again elsewhere
'Salutation
objSelection.font.color = rgb(0,0,0)
objSelection.TypeText "Regards,"
'Line break
'objSelection.TypeText Chr(11)
objSelection.TypeParagraph()
'Username line
objSelection.Font.Size = 12
objSelection.Font.Bold = true
if (strCred) Then objSelection.TypeText strName & ", " & strCred Else objSelection.TypeText strName
objSelection.Font.Bold = false
'Job title line
objSelection.Font.Size = 10
objSelection.TypeParagraph()
objSelection.ParagraphFormat.LineSpacing = 16
objSelection.TypeText strTitle
objSelection.TypeText Chr(11)
'Location line
objSelection.Font.Bold = true
objSelection.font.color = rgb(210,73,42)
objSelection.TypeText strOffice & " Office " & "| CompanyName"
objSelection.Font.Bold = False
objSelection.TypeText Chr(11)
'Address line
objSelection.Font.Size = 9
objSelection.font.color = rgb(0,0,0)
objSelection.TypeText strStreet & ", " & strLocation & ", " & strState & ", " & strPostCode
objSelection.TypeText Chr(11)
'Contact line
objSelection.Font.Size = 8
objSelection.font.color = rgb(0,0,0)
'Formatted to print results horizontally - to print vertically add objSelection.TypeText Chr(11) in between each object
'If the data is not present in the AD it will not print anything and move on to the next field.
If Not IsEmpty(strPhone) Then
objselection.typetext "P: " & strPhone
End If
If Not IsEmpty(strDirect) Then
objselection.typetext " | D: " & strDirect
End If
If Not IsEmpty(strmobile) Then
objselection.typetext " | M: " & strMobile
End If
If Not IsEmpty(strEmail) Then
objselection.typetext " | E: " & strEmail
End If
If Not IsEmpty(strWebsite) Then
objselection.typetext " | W: " & strWebsite
End If
objSelection.TypeText Chr(11)
' If statement to hyperlink website
' Don't really need this as most email clients auto format the email and website to hyperlinks
' if strWebsite then
' Set objLink = objSelection.Hyperlinks.Add(objselection.Range,strWebsite)
' objLink.Range.Font.Name = "Verdana"
' objLink.Range.Font.Size = 8
' objLink.Range.Font.Bold = false
' end if
' objSelection.TypeText Chr(11)
'Image description or disclaimer
objSelection.Font.Size = 9
objSelection.Font.Bold = true
objSelection.font.color = rgb(0,187,0)
objSelection.TypeText "Disclaimer"
objSelection.Font.Bold = false
objSelection.TypeText Chr(11)
'New signature image adding - Place script and file in NETLOGON and adjust image file path
Set shp = objSelection.InlineShapes.AddPicture("NETLOGON\PIC.jpg")
shp.LockAspectRatio = msoFalse
shp.Width = 456
shp.Height = 86
'Can make an if statement for if there is a badge signature instead of a banner.
'Code for multuple departments with different signature images
' If (objUser.Department = "COMPANY NAME.") Then
' objSelection.InlineShapes.AddPicture("\PIC")
' ElseIf (objUser.Department = "COMPANY NAME") Then
' objSelection.InlineShapes.AddPicture("\PIC")
' Else
' objSelection.InlineShapes.AddPicture("\PIC")
' End If
Set objSelection = objDoc.Range()
objSignatureEntries.Add "EmailSignature", objSelection
objSignatureObject.NewMessageSignature = "EmailSignature"
objSignatureObject.ReplyMessageSignature = "EmailSignature"
objDoc.Saved = True
objWord.Quit
Я работаю над кодом, поэтому у меня есть много комментариев, чтобы следовать.
Если у кого-то есть идеи, которые были бы чрезвычайно полезны.