MS Access Edge浏览器控件调用tel/mailto链接失效问题求助

Edge浏览器控件默认不会自动处理tel:、mailto:这类非HTTP协议的链接，这就是点击后表单无响应的核心原因。解决方法是拦截控件的导航事件，手动调用系统功能来打开对应协议的应用。

步骤1：声明ShellExecute API #

在表单的VBA模块顶部添加以下API声明，用于唤起系统对应应用：

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hwnd As LongPtr, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long _
) As LongPtr

步骤2：添加NavigationStarting事件处理 #

为Edge浏览器控件绑定NavigationStarting事件，拦截并处理tel/mailto链接：

Private Sub EdgeBrowser2_NavigationStarting(sender As Object, e As Microsoft.Office.Core.WebBrowserNavigationStartingEventArgs)
    Dim targetUrl As String
    targetUrl = e.Url
    
    ' 处理tel协议链接
    If VBA.Left(targetUrl, 4) = "tel:" Then
        e.Cancel = True ' 取消控件默认导航行为
        ' 唤起系统拨号应用
        ShellExecute Me.hwnd, "open", targetUrl, vbNullString, vbNullString, 1
    ' 处理mailto协议链接
    ElseIf VBA.Left(targetUrl, 7) = "mailto:" Then
        e.Cancel = True
        ' 唤起默认邮件客户端
        ShellExecute Me.hwnd, "open", targetUrl, vbNullString, vbNullString, 1
    End If
End Sub

步骤3：保留原有HTML加载代码 #

你之前的Form_Load加载逻辑无需修改，正常保留即可：

Private Sub Form_Load()
    Dim w As String
    Dim sJS As String
    
    w = "<a href='tel:5555555555'>call 5555555555</a>"
    sJS = "document.open();document.write(""" & w & """);document.close();"
    
    Me.EdgeBrowser2.Navigate "about:blank"
    Do
        DoEvents
    Loop Until EdgeBrowser2.ReadyState = READYSTATE_COMPLETE ' READYSTATE_COMPLETE=4
    
    Me.EdgeBrowser2.ExecuteJavascript sJS
End Sub

原理说明 #

旧版WebBrowser控件会自动将tel/mailto这类协议交给系统处理，但Edge控件出于安全和行为一致性考虑，默认仅支持HTTP/HTTPS链接。通过拦截NavigationStarting事件，我们取消控件的无效默认导航，转而调用系统ShellExecute函数，从而唤起对应协议的应用（如拨号器、邮件客户端），和旧版控件的行为保持一致。

内容的提问来源于stack exchange，提问作者LesD