VBScript：创建 Outlook 签名 - 如何超链接电话号码？

Question

我有一个我一直在研究的 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

我正在编写代码，所以我有很多 cmets 可以跟进。

如果有人有任何非常有帮助的想法。

Answer 1

您需要tel:1234567890 格式的超链接，就像http://xyz.demo 链接一样。