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

VBScript:Outlook签名创建-如何超链接电话号码?,vbscript,outlook,email,Vbscript,Outlook,Email,我有一个vbscript,我一直在工作,它将根据广告信息生成一个签名文件。非常普通的脚本,我已经对它进行了调整,除了一件事之外,它工作得非常完美 我一辈子都搞不懂如何让签名文件将电话号码识别为链接。我们使用Mitel电话系统软件,只需点击签名中的链接,而不是复制粘贴到拨号器中,这将是一种生活质量更新 编辑:我基本上需要与此等效的vbs <a href="tel:+12345678910"><span class=ContactDetail>+12 345 678 910&

我有一个vbscript,我一直在工作,它将根据广告信息生成一个签名文件。非常普通的脚本,我已经对它进行了调整,除了一件事之外,它工作得非常完美

我一辈子都搞不懂如何让签名文件将电话号码识别为链接。我们使用Mitel电话系统软件,只需点击签名中的链接,而不是复制粘贴到拨号器中,这将是一种生活质量更新

编辑:我基本上需要与此等效的vbs

<a href="tel:+12345678910"><span class=ContactDetail>+12 345 678 910</span></a>
我正在编写代码,所以我有很多注释要遵循


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

您需要一个超链接,格式为
电话:1234567890
,非常类似
http://xyz.demo
链接

谢谢你,伙计。我计算出objLink=objSelection.Hyperlinks.Add(objSelection.Range,“tel:”&strMobile,,strMobile,strMobile)
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