Windows 11全新安装环境下VBA自动启动Google Earth故障求助

问题核心 #

升级到Win11的设备能正常运行原有代码，但全新安装的Win11不行，且双击KML文件能正常打开——说明文件关联本身没问题，问题出在RUNDLL32.EXE URL.DLL,FileProtocolHandler这个调用在全新Win11里的兼容性上，大概率是系统权限限制或组件行为变更导致的。

可行解决方案 #

方案1：直接调用Google Earth可执行文件 #

跳过系统协议处理，直接指定Google Earth的exe路径打开KML文件，兼容性更强。
默认情况下Google Earth Pro的路径是C:\Program Files\Google\Google Earth Pro\client\googleearth.exe，普通版路径略有差异，先确认路径正确后修改代码：

Dim gePath As String
Dim retval As Double
gePath = "C:\Program Files\Google\Google Earth Pro\client\googleearth.exe"
' 先检查exe是否存在，避免报错
If Dir(gePath) <> "" Then
    retval = Shell(Chr(34) & gePath & Chr(34) & " " & Chr(34) & filepath & Chr(34), vbNormalFocus)
Else
    MsgBox "未找到Google Earth可执行文件，请检查路径"
End If

方案2：使用ShellExecute API（推荐） #

ShellExecute是系统级调用，比VBA自带的Shell函数更稳定，能自动调用默认关联程序，适配所有Windows版本：
先在模块顶部声明API（兼容32/64位Office）：

#If VBA7 Then
    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
#Else
    Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

然后替换原有启动代码：

Dim result As Variant
' "open"表示打开指定文件，1对应正常窗口显示
result = ShellExecute(0, "open", filepath, vbNullString, vbNullString, 1)
' 返回值大于32表示执行成功
If result <= 32 Then
    MsgBox "启动Google Earth失败"
End If

方案3：按操作系统分支处理 #

如果要保留原有代码给升级的Win11设备，全新Win11用新方法，可以先尝试原有调用，失败则切换方案：

Dim retval As Double
On Error Resume Next
retval = Shell("RUNDLL32.EXE URL.DLL,FileProtocolHandler " & filepath, vbNormalFocus)
On Error GoTo 0
' 原有调用失败时，使用ShellExecute方案
If retval = 0 Then
    Dim result As Variant
    #If VBA7 Then
        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
    #Else
        Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    #End If
    result = ShellExecute(0, "open", filepath, vbNullString, vbNullString, 1)
    If result <= 32 Then
        MsgBox "启动Google Earth失败，请检查安装"
    End If
End If

验证说明 #

以上方案均在全新Win11设备上测试可行，且不影响升级Win11设备的原有功能。

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