☰

如何使用非默认浏览器从 Excel 单元格（超链接）打开 URL 链接？

tag-icon • tag-icon microsoft-excel command-line powershell browser
如何使用非默认浏览器从 Excel 单元格（超链接）打开 URL 链接？

我有一张包含 URL 的 Excel 工作表，我想使用单独的浏览器打开它。我知道如何使用 Windows 内置功能设置不同应用程序使用的默认浏览器：

cmd /c assoc
cmd /c ftype

这将显示（相关）值如下：

    
    Value Data  Browser
    -----------------------------------------
    BraveHTML                       Brave
    ChromeHTML                      Chrome
    FirefoxHTML-308046B0AF4A39CB    Firefox
    IE.HTTP                         Internet Explorer
    MSEdgeHTM                       EDGE
    -----------------------------------------

您还可以使用以下方式通过 powershell 访问此信息：

# For HTTP
Get-ItemProperty HKCU:\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\http\UserChoice -Name ProgId

# For HTTPS
Get-ItemProperty HKCU:\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\https\UserChoice -Name ProgId

对于 Excel，我们有：

    Excel.UriLink.16=C:\Program Files\Microsoft Office\Root\Office16\protocolhandler.exe "%1"
    Excelhtmlfile="C:\Program Files\Microsoft Office\Root\Office16\EXCEL.EXE"

这里的问题是protocolhandler.exe它还处理内部引用，谁知道还有什么。对于 URL（超链接），它将其传递给默认浏览器。

我想将其包装为仅将 HTTP URL 链接传递给勇敢的浏览器（例如）

我怎样才能包装此命令来执行上述操作，并在完成后轻松恢复？

没有帮助的类似问题：

答案1

每gns100 的评论您可以使用 VBA 程序在所选的 Web 浏览器中打开 URL。

网络上有特定于浏览器的脚本，但是 Daniel Pineault 的 VBA 程序发布在开发者之家支持将 URL 定向到以下 6 种浏览器之一：Brave、Internet Explorer、Firefox、Chrome、Opera 和 Edge。您可以根据所使用的调用在同一文档中按 URL 交替使用浏览器。

来源：控制所有问题的程序

Enum BrowserName
    'This Enum is part of Sub OpenURL()
    ' *** If changes are made here, update GetBrowserNameEnumValue()
    iexplore = 1
    firefox = 2
    chrome = 3
    opera = 4
    msedge = 5
    brave = 6
End Enum


'---------------------------------------------------------------------------------------
' Procedure : OpenURL
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Open a URL in a browser
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
' Dependencies: BrowserName Enum, GetDefaultBrowser(), GetBrowserNameEnumValue()
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sURL      : URL to open
' lBrowser  : Optional, browser to be used to open the URL, if omitted, the system's
'               default browser will be used
'
' Usage:
' ~~~~~~
' Call OpenURL("https://www.google.ca") 'will use the user's default browser
' Call OpenURL("https://www.google.ca", iexplore)
' Call OpenURL("devhut.net", chrome)
' Call OpenURL("msdn.com", firefox)
' Call OpenURL("google.ca", opera)
' Call OpenURL("https://www.google.ca", msedge)
' Call OpenURL("https://www.google.ca", brave)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2014-11-13              Initial Release
' 2         2018-02-01              Updated Copyright under CC licensing
'                                   Error trapped FireFox not installed
' 3         2018-02-01              Complete revamp of the code to accomodate multiple
'                                   Browser
' 4         2020-04-27              Added Microsoft Edge
'                                   Added Brave
' 5         2020-12-14              Adapted to now have lBrowser as optional and the
'                                   ability to determine the system's default browser
' 6         2022-07-03              Fixed usage examples to match Enum, forgot to do so
'                                   after the last update
'                                   changed msedge sExe to make people happy, not used!
'---------------------------------------------------------------------------------------
Sub OpenURL(ByVal sURL As String, Optional lBrowser As BrowserName)
    Dim oShell                As Object
    Dim sFFExe                As String     'Executable path/filename
    Dim sProgName             As String     'Name of the Executable program
    Dim sExe                  As String     'Executable exe filename
    Dim sCmdLineSwitch        As String     'Command line switch
    Dim sShellCmd             As String     'Shell Command

    On Error GoTo Error_Handler

    'If no browser is specified then use the system's default one
    If lBrowser = 0 Then
        lBrowser = GetBrowserNameEnumValue(GetDefaultBrowser())
    End If

    'Determine the Path to executable
    Select Case lBrowser
        Case 1
            'https://msdn.microsoft.com/en-us/library/hh826025(v=vs.85).aspx
            sProgName = "Internet Explorer"
            sExe = "IEXPLORE.EXE"
            sCmdLineSwitch = " "
        Case 2
            'https://developer.mozilla.org/en-US/docs/Mozilla/Command_Line_Options#Browser
            sProgName = "Mozilla Firefox"
            sExe = "Firefox.EXE"
            sCmdLineSwitch = " -new-tab "
        Case 3
            sProgName = "Google Chrome"
            sExe = "Chrome.exe"
            sCmdLineSwitch = " -tab "
        Case 4
            'http://www.opera.com/docs/switches/
            sProgName = "Opera"
            sExe = "opera.exe"
            sCmdLineSwitch = " "
        Case 5
            sProgName = "Microsoft Edge"
            sExe = "msedge.exe"
            sCmdLineSwitch = " -tab "
        Case 6
            sProgName = "Brave"
            sExe = "brave.exe"
            sCmdLineSwitch = " -tab "
    End Select

    If lBrowser = 5 Then    'Special case for Edge!  Thank you Microsoft for not following the rules!
        'Build the command
        sShellCmd = "cmd /c """ & "start microsoft-edge:" & sURL & """"
    Else
        Set oShell = CreateObject("WScript.Shell")
        sFFExe = oShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\" & _
                                "CurrentVersion\App Paths\" & sExe & "\")
        'Parse the returned string
        sFFExe = Replace(sFFExe, Chr(34), "")    'Special case for Opera?!
        'Build the command
        sShellCmd = """" & sFFExe & """" & "" & sCmdLineSwitch & """" & sURL & """"
    End If
    'Open the URL
    Shell sShellCmd, vbHide

Error_Handler_Exit:
    On Error Resume Next
    If Not oShell Is Nothing Then Set oShell = Nothing
    Exit Sub

Error_Handler:
    If Err.Number = -2147024894 Then
        MsgBox sProgName & " does not appear to be installed on this compter", _
               vbInformation Or vbOKOnly, "Unable to open the requested URL"
    Else
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: OpenURL" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occurred!"
    End If
    Resume Error_Handler_Exit
End Sub

'---------------------------------------------------------------------------------------
' Procedure : GetDefaultBrowser
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Returns the name of the System's Default Web Browser
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Usage:
' ~~~~~~
' GetDefaultBrowser()
'   -> msedge, firefox, brave, iexplore, ...
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2020-12-14              Initial Release
'---------------------------------------------------------------------------------------
Function GetDefaultBrowser() As String
    Dim oShell                As Object
    Dim sProgId               As String
    Dim sCommand              As String
    Dim aCommand              As Variant

    On Error GoTo Error_Handler

    Set oShell = CreateObject("WScript.Shell")
    'Default ProgId
    sProgId = oShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations" & _
                             "\UrlAssociations\https\UserChoice\ProgId")
    'Cross-reference the sProgId to get the exe associated with it
    sCommand = oShell.RegRead("HKEY_CLASSES_ROOT\" & sProgId & "\shell\open\command\")
    'Parse the returned value to extract just the exe filename
    aCommand = Split(sCommand, Chr(34))
    GetDefaultBrowser = Right(aCommand(1), Len(aCommand(1)) - InStrRev(aCommand(1), "\"))    ' firefox.exe
    GetDefaultBrowser = Left(GetDefaultBrowser, InStr(GetDefaultBrowser, ".") - 1)    'firefox

Error_Handler_Exit:
    On Error Resume Next
    If Not oShell Is Nothing Then Set oShell = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetDefaultBrowser" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetBrowserNameEnumValue
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Convert the returned value from GetDefaultBrowser() into the proper Enum
'               Value.  This is required as VBA offers no way to evaluate a returned
'               value from a function against an Enum, no way to iterate over the string
'               values of an Enum, ...
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Usage:
' ~~~~~~
' GetBrowserNameEnumValue(GetDefaultBrowser())
'   -> 1, 2, 3, ...
' GetBrowserNameEnumValue("firefox")
'   -> 2
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2020-12-14              Initial Release
'---------------------------------------------------------------------------------------
Function GetBrowserNameEnumValue(sInput As String) As Long
    On Error GoTo Error_Handler

    Select Case sInput
        Case "iexplore"
            GetBrowserNameEnumValue = BrowserName.iexplore
        Case "firefox"
            GetBrowserNameEnumValue = BrowserName.firefox
        Case "chrome"
            GetBrowserNameEnumValue = BrowserName.chrome
        Case "opera"
            GetBrowserNameEnumValue = BrowserName.opera
        Case "msedge"
            GetBrowserNameEnumValue = BrowserName.msedge
        Case "brave"
            GetBrowserNameEnumValue = BrowserName.brave
        Case Else
            GetBrowserNameEnumValue = 0
    End Select

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetBrowserNameEnumValue" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

答案2

据我了解，Excel 的.xlsx文件格式不支持调用外部命令。通过将 Excel 中的超链接指向 Windows 快捷方式（.lnk或.url文件）来代替，怎么样？

  1. 创建 Brave 或 Chrome 程序的 Windows 快捷方式
    "C:\Program Files (x86)\BraveSoftware\Brave-Browser\Application\brave.exe"
  2. 编辑快捷方式的“目标”字段并附加目标 URL
    "C:\Program Files (x86)\BraveSoftware\Brave-Browser\Application\brave.exe" www.yahoo.com
  3. 创建一个 Excel HYPERLINK 公式，指向快捷方式的完整路径而不是 URL
    =HYPERLINK("C:\Path\To\Shortcut\shortcut_name.lnk")

此方法无需任何 VBA 编码，也不会触发防病毒警告。此外，打开 Excel 文件时不会触发任何安全警告。与更改文件扩展名或创建批处理文件相比，它要容易得多。

这种方法的缺点是您需要为每个 URL 单独创建和维护一个快捷方式文件。对 URL 的任何更改都需要手动编辑相关快捷方式的目标字段。

答案3

使用 Powershell 和 ImportExcel 模块非常简单：在我的示例中，我的电子表格有三列，DATE, URL, OTHER_INFO和网址列中有链接。

安装导入Excel模块。从模块中，使用匯入Excelcmdlet 将电子表格读入变量，然后使用 foreach 循环打开每个链接：

$excel = Import-Excel -Path "C:\Users\UserName\Desktop\Temp\test.xlsx"
$brows = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"
foreach ($url in $excel.URL){
    Start-Process -FilePath $brows -ArgumentList $url
    #    Write-Host $brows $url  ## TEST
    }

Start-Process -FilePath $brows -ArgumentList $url

这将在 MS Edge 的新选项卡中打开每个链接。

如果您无法使用 ImportExcel 模块，它会更冗长，但您仍然可以使用 COM 对象访问电子表格数据

在示例中，将浏览器的路径替换为您要使用的任何浏览器的路径。（注意：我使用的是 MS Edge 的完整路径，因为我不使用 Brave 浏览器。）

这还有一个额外的好处，就是不需要撤销更改。

相关内容