Excel宏调用Chrome打开网站跨电脑失效，如何免硬编码路径？

硬编码Chrome的绝对路径会因为系统位数、自定义安装路径等问题导致跨电脑失效，我们可以通过读取Windows注册表来获取Chrome的默认安装路径，修改后的代码如下：

Sub Test()
    Dim chromePath As String
    Dim navigateUrl As String
    
    navigateUrl = "https://www.example.com" ' 替换成你要打开的网址
    chromePath = GetChromePath()
    
    If chromePath <> "" Then
        ' 调用Chrome并打开指定网址，双引号包裹路径避免空格报错
        Shell """" & chromePath & """ -url " & navigateUrl, vbNormalFocus
    Else
        MsgBox "未找到Chrome浏览器，请确认已安装", vbExclamation
    End If
End Sub

Function GetChromePath() As String
    Dim regPath64 As String
    Dim regPath32 As String
    
    ' 64位系统下Chrome的注册表路径
    regPath64 = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe\"
    ' 32位系统或64位系统中32位Chrome的注册表路径
    regPath32 = "HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe\"
    
    ' 优先尝试读取64位路径
    On Error Resume Next
    GetChromePath = CreateObject("WScript.Shell").RegRead(regPath64 & "Path") & "chrome.exe"
    On Error GoTo 0
    
    ' 64位路径不存在则尝试读取32位路径
    If GetChromePath = "" Then
        On Error Resume Next
        GetChromePath = CreateObject("WScript.Shell").RegRead(regPath32 & "Path") & "chrome.exe"
        On Error GoTo 0
    End If
    
    ' 验证路径是否真实存在
    If Dir(GetChromePath) = "" Then
        GetChromePath = ""
    End If
End Function

关键说明： #

• GetChromePath函数：通过读取Windows注册表中Chrome的注册信息，自动适配不同系统的安装路径，覆盖64位/32位系统、常规/自定义安装场景
• 调用Shell时用双引号包裹Chrome路径，避免路径含空格导致命令执行失败
• 增加路径有效性校验，未找到Chrome时弹出提示框

内容的提问来源于stack exchange，提问作者Olivier Ponton-Lemieux