这里有另一个方法供你尝试。请注意，您可能会看到一个黑框弹出了一会儿，这是正常的。

Function GetInstallDirectory(appName As String) As String

    Dim retVal As String
    retVal = Split(CreateObject("WScript.Shell").Exec("CMD /C FOR /r ""C:\"" %i IN (*" & appName & ") DO (ECHO %i)").StdOut.ReadAll, vbCrLf)(2)
    GetInstallDirectory = Left$(retVal, InStrRev(retVal, "\"))

End Function

它不像使用API那样干净，但应该可以完成任务。

• 摘要：*

retVal = Split(CreateObject("WScript.Shell").Exec("CMD /C FOR /r ""C:\"" %i IN (*" & appName & ") DO (ECHO %i)").StdOut.ReadAll, vbCrLf)(1)

• "CMD /C FOR /r ""C:\"" %i IN (*" & appName & ") DO (ECHO %i)"是CMD中的一个命令，用于循环访问根目录为已定义路径的文件。我们使用通配符和appName变量来测试我们想要的程序。(more info on FOR /R here)在这里，我们使用Shell对象（WScript.Shell）创建了CMD应用程序，并在命令提示符CMD之后直接向其传递参数。/C开关意味着我们要向CMD传递一个命令，然后在处理完后立即关闭窗口。
• 然后，我们使用.StdOut.ReadAll通过Standard****Output流读取该命令的所有输出。
• 接下来，我们将其 Package 在Split()方法中，并将输出拆分到vbCrLf（Carriagereturn &Linefeed）上，这样我们的每行输出都有一个一维数组。因为该命令在CMD中的新行上输出每个命中，所以这是理想的。
• 输出如下所示：

C：\Users\MM\Documents>（ECHO C：\Program Files\Microsoft Office\Office14\EXCEL.EXE）C：\Program Files\Microsoft Office\Office14\EXCEL.EXE
C：\Users\MM\Documents>（ECHO C：\Windows\Installer$PatchCache$\Managed\00004109110000000000000F01FEC\14.0.4763\EXCEL.EXE）C：\Windows\Installer$PatchCache$\Managed\00004109110000000000000F01FEC\14.0.4763\EXCEL.EXE
C：\Users\olearysa\Documents>（ECHO C：\Windows\Installer$PatchCache$\Managed\00004109110000000000000F01FEC\14.0.7015\EXCEL.EXE）C：\Windows\Installer$PatchCache$\Managed\00004109110000000000000F01FEC\14.0.7015\EXCEL.EXE

• 我们只对输出的第三行感兴趣（第一行实际上是空白的），所以我们可以通过在后面使用(2)直接访问数组的索引（因为数组默认为零索引）
• 最后，我们只需要路径，所以我们使用Left$()（将返回从字符串左侧开始的 n 个字符）和InStrRev()（返回从末尾开始并向后移动的子字符串的位置）的组合。这意味着我们可以在向后搜索字符串时指定从左边开始的所有内容，直到第一次出现\。

给予一下，假设你知道.exe的名称：

#If Win64 Then
    Declare PtrSafe Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
        (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#Else
    Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
        (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#End If

Const SYS_OUT_OF_MEM        As Long = &H0
Const ERROR_FILE_NOT_FOUND  As Long = &H2
Const ERROR_PATH_NOT_FOUND  As Long = &H3
Const ERROR_BAD_FORMAT      As Long = &HB
Const NO_ASSOC_FILE         As Long = &H1F
Const MIN_SUCCESS_LNG       As Long = &H20
Const MAX_PATH              As Long = &H104

Const USR_NULL              As String = "NULL"
Const S_DIR                 As String = "C:\" '// Change as required (drive that .exe will be on)

Function GetInstallDirectory(ByVal usProgName As String) As String

    Dim fRetPath As String * MAX_PATH
    Dim fRetLng As Long

    fRetLng = FindExecutable(usProgName, S_DIR, fRetPath)

    If fRetLng >= MIN_SUCCESS_LNG Then
        GetInstallDirectory = Left$(Trim$(fRetPath), InStrRev(Trim$(fRetPath), "\"))
    End If

End Function

如何使用的例子，让我们尝试寻找Excel：

Sub ExampleUse()

Dim x As String

x = "EXCEL.EXE"

Debug.Print GetInstallDirectory(x)

End Sub

输出（在我的机器上）是
C：\Program Files\Microsoft Office\Office14\

假设您只在PC上工作，并且人们使用自己的副本而不是共享的网络副本。我建议如下。
1.创建一个名为“配置”的工作表，将路径与exe放在那里，然后隐藏它。
1.使用use FileScriptingObject（'Tools' > 'References' > 'Microsoft Scripting Runtime'）查看'Config'中的路径是否存在
1.如果没有，使用“打开文件对话框”询问用户位置，并记住下次在“配置”表中。
下面的代码可以作为一个指针。

Dim FSO As New FileSystemObject

Private Function GetFilePath() As String
Dim FlDlg           As FileDialog
Dim StrPath         As String
Set FlDlg = Application.FileDialog(msoFileDialogOpen)
    With FlDlg
        .Filters.Clear
        .Filters.Add "Executable Files", "*.exe"
        .AllowMultiSelect = False
        .ButtonName = "Select"
        .Title = "Select the executable"
        .Show
        If .SelectedItems.Count <> 0 Then GetFilePath = .SelectedItems(1)
    End With
Set FlDlg = Nothing
End Function

Private Function FileExists(ByVal StrPath As String) As Boolean
FileExists = FSO.FileExists(StrPath)
End Function

这里是另一个更快的方法，为了比较，“SierraOscar”解决方案花了我20秒，下一个解决方案花了不到一秒。

Function GetInstallFullPath(AppName) As String
    GetInstallFullPath = CreateObject("WScript.Shell").Exec("cmd.exe /c where " & AppName).StdOut.ReadAll
End Function

这样使用：

AppName = "gswin64c"
    AppPath = GetInstallFullPath (AppName)