Vba 如何找到特定程序的安装目录？

我已经成功地编写了一些VBA宏的工作，基本上是创建一个数据文件，饲料到一个程序和后期处理从这个程序的输出。 我的问题是，程序安装路径在宏中是硬编码的，安装可能因我同事的计算机而异

我想到的第一件事是，我可以从每个人那里收集不同的安装目录，并在代码中测试它们。希望其中一个能起作用。但感觉不太干净

所以我的另一个想法是以某种方式在代码中获取安装目录。我想，在Windows中，如果我右键单击快捷方式，我可以请求打开文件的目录。基本上，我所寻找的是在VBA中类似于Windows中的右键单击操作。这就是我被困的地方。 从我发现的情况来看，WindowsAPI可能完成了这项工作，但我对VBA的了解还远远不够

API FindExecutable似乎离我想要的不远，但我仍然无法正确使用它。到目前为止，我只能让程序运行，如果我已经知道它的目录

---

你能给我一些指点吗？谢谢。

假设您只在PC上工作，而用户使用的是他们自己的副本，而不是共享的网络副本。我建议如下

创建一个名为“Config”的工作表，将包含exe的路径放在其中，然后将其隐藏

使用FileScriptingObject（'Tools'>'References'>'Microsoft Scripting Runtime'）查看'Config'中的路径是否存在

如果没有，请使用“打开文件对话框”询问用户位置，并在下次的“配置”表中记住

下面的代码可能有助于作为指针

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

Dim FSO作为新的FileSystemObject
私有函数GetFilePath（）作为字符串
Dim FlDlg As FileDialog
将StrPath设置为字符串
Set FlDlg=Application.FileDialog（msoFileDialogOpen）
与FlDlg
.过滤器
.Filters.Add“可执行文件”、“*.exe”
.AllowMultiSelect=False
.ButtonName=“选择”
.Title=“选择可执行文件”
显示
如果.SelectedItems.Count为0，则GetFilePath=.SelectedItems（1）
以
设置FlDlg=Nothing
端函数
私有函数FileExists（ByVal StrPath作为字符串）为布尔值
FileExists=FSO.FileExists（StrPath）
端函数

如果您知道.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\

---

这里有另一种方法供您尝试。请注意，您可能会看到一个黑匣子弹出片刻，这是正常的

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那样干净，但应该可以完成这个技巧

---

摘要：

• “CMD/C FOR/r”“C:\”“%i IN（*“&appName&”）DO（ECHO%i）”

  是一个在CMD中工作的命令，用于循环遍历以定义路径为根的文件。我们使用带有

  appName

  变量的通配符来测试所需的程序。在这里，我们使用Shell对象（

  WScript.Shell

  ）创建了CMD应用程序，并在命令提示符

  CMD

  之后直接向其传递参数。

  /C

  开关意味着我们要将命令传递到

  CMD

  ，然后在处理完后立即关闭窗口

• 然后，我们使用

  .StdOut.ReadAll

  通过StandardOutput流读取该命令的所有输出

• 接下来，我们将其包装在

  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\00004109100000000000000F01FEC\14.0.4763\EXCEL.EXE ) C:\Windows\Installer\$PatchCache$\Managed\00004109100000000000000F01FEC\14.0.4763\EXCEL.EXE

C:\Users\olearysa\Documents>（ECHO C:\Windows\Installer\$PatchCache$\Managed\00004109100000000000000F01FEC\14.0.7015\EXCEL.EXE ) C:\Windows\Installer\$PatchCache$\Managed\00004109100000000000000F01FEC\14.0.7015\EXCEL.EXE

• 我们只对输出的第三行感兴趣（第一行实际上是空的），因此我们可以通过在它之后使用

  （2）

  直接访问数组的索引（因为默认情况下数组的索引为零）

• 最后，我们只需要路径，因此我们使用

  Left$（）

  （从字符串左侧返回n个字符）和

  instrev（）

  （返回从末尾开始并向后移动的子字符串的位置）的组合。这意味着在向后搜索字符串时，可以指定从左到第一次出现

  \

  的所有内容

---

不幸的是，该文件是一个模板，可能会随着时间的推移而改变。它将存储在共享网络上，因此让每个人都保留一份副本并不是最好的解决方案：您应该能够通过计算机名

Environ（“ComputerName”）

编辑配置和存储路径。然后您可以在那里查找。应用程序是否有特定的文件扩展名？或者您知道.exe文件的正确名称吗？它是一个基本的.exe文件，程序名称不应因计算机而异。只有安装目录。没关系，我只是把答案放在一起

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