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

我已经成功编写了一些VBA宏，用于基本上创建数据文件的工作，将其提供给程序并对该程序的输出进行后处理。我的问题是程序安装路径在宏中被硬编码，并且安装可能会因我的同事计算机而异。如何找到特定程序的安装目录？

我认为的第一件事是我可以从每个人那里收集不同的安装目录，并在代码中测试它们中的所有目录。希望其中一个会起作用。但它并不觉得那么干净。

所以我的另一个想法是以某种方式获取代码中的安装目录。我认为这将有可能在Windows中，如果我右键单击快捷方式，我可以要求打开文件的目录。我基本上在寻找的是在Windows中的这种右键单击操作的VBA中的等价物。这就是我卡住的地方。从我发现的情况来看，Windows API可能会完成这项工作，但这确实超出了我对VBA的了解。

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

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

来源

2016-05-13 BluK

该应用程序是否有特定的文件扩展名？或者你知道.exe文件的正确名称？ –

这是一个基本的.exe，程序的名称不应该根据计算机而改变。只有安装目录。 – BluK

这很好 - 我只是给你一个答案，但它需要一个唯一的文件扩展名或.exe的名称 –

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

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）和Exec的的CMD应用后直接贡献命令提示CMD将参数传递给它。该/C开关意味着我们希望将命令传递给CMD，然后立即关闭该窗口，它的处理后。
然后，使用.StdOut.ReadAll通过圣安达d出放流，读所有的输出从该命令。
接下来，我们总结，在一个Split()方法和vbCrLf（ç arriage ř E打开& 大号 INE ˚F EED），使我们具有与每个线一维阵列分割输出的输出。因为命令在CMD中输出每一个新命令，所以这是理想的。
输出看起来是这样的：

C：\用户\ MM \文件>（ECHO C：\ Program Files文件\微软办公室\ OFFICE14 \ EXCEL.EXE）C： \ Program Files文件\微软办公室\ OFFICE14 \ EXCEL.EXE

C：\用户\ MM \文件>（ECHO C：\ WINDOWS \ Installer程序\ $ PatchCache $ \管理\ 00004109110000000000000000F01FEC \ 14.0.4763 \ EXCEL。 EXE ） C：\ WINDOWS \宏高\ $ PatchCache $ \管理\ 00004109110000000000000000F01FEC \ 14.0.4763 \ EXCEL.EXE

C：\用户\ olearysa \文件>（ECHO C：\ WINDOWS \ Installer程序\ $ PatchCache $ \管理\ 00004109110000000000000000F01FEC \ 14.0。 7015 \ EXCEL.EXE ） C：\ WINDOWS \ Installer程序\ $ PatchCache $ \管理\ 00004109110000000000000000F01FEC \ 14.0.7015 \ EXCEL.EXE

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

来源

2016-05-13 15:32:26

我会在星期二尝试它并回复你:)谢谢！ – BluK

哇！有用！非常感谢你的帮助。通过详细说明第一行的内容，请求你详细解答答案是否太多了？（我的意思是/ C FOR/r等等）。这样，下次我可能会想到类似的问题。 – BluK

@BluK肯定 - 2分钟 –

假设你只在PC上工作，人们正在使用自己的副本而不是共享网络副本。我会建议以下。

创建一个名为'Config'的工作表，将带有exe的路径放在那里，然后隐藏它。
用途使用FileScriptingObject（“工具”>“引用”>“Microsoft脚本运行时”），看看是否在“配置”存在的路径
如果没有，用询问的位置的用户一个'打开文件对话框'，并记住下次'配置'表。

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

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

来源

2016-05-13 12:29:38

不幸的是，该文件是一个可能随时间而改变的模板。它将被存储在共享网络中，因此每个人都保留一份副本并不是最佳解决方案：s – BluK

您应该能够通过计算机名称'Environ（“ComputerName”）'编辑配置和存储路径。你可以在那里查看它。 –

这个试用一下，假设你知道.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 Offic e \ Office14 \

来源

2016-05-13 13:37:46

我测试了一下。它适用于Excel，但不适用于其他程序（我测试了几个）。它确实有效，但是如果我用正确的路径替换S_DIR，但又一次，这是我正在寻找的。我不确定我是否了解代码中的所有内容，但fRetLng返回2，所以我认为这意味着文件未找到。 – BluK

您是否尝试用驱动器和单个文件夹替换'S_DIR'？推测它总是会在Program Files中呢？ –

我试着用安装的根目录重新安装S_DIR，即使它没有找到它。如果我用“C：\ Program Files \”替换它，它仍然不起作用。 – BluK

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

回答

相关问题