Question

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

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

所以我的另一个想法是以某种方式获取代码中的安装目录。我认为有可能在Windows中，如果我右键单击快捷方式，我可以要求打开文件的目录。我基本上寻找的是Windows中右键单击操作的VBA等效内容。那就是我被困住的地方。根据我的发现，Windows API可能会完成工作，但这完全超出了我对VBA的了解。

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

你可以给我一些指示吗？感谢。

Answer 1

Here's another method for you to try. Note that you might see a black box pop up for a moment, that's normal.

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

It's not as clean as using API but should get the trick done.

Summary:

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)" is a command that works in CMD to loop through files rooted at a defined path. We use the wildcard with the appName variable to test for the program we want. (more info on FOR /R here) Here, we have created the CMD application using a Shell object (WScript.Shell) and Executed the command prompt CMD passing arguments to it directly after. The /C switch means that we want to pass a command to CMD and then close the window immediately after it's processed.
We then use .StdOut.ReadAll to read all of the output from that command via the Standard Output stream.
Next, we wrap that in a Split() method and split the output on vbCrLf (Carriage return & Line feed) so that we have a single dimension array with each line of the output. Because the command outputs each hit on a new line in CMD this is ideal.
The output looks something like this:

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

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

We're only interested in the third line of the output (the first line is actually blank), so we can access that index of the array directly by using (2) after it (because arrays are zero-indexed by default)
Finally, we only want the path so we use a combination of Left$() (which will return n amount of characters from the left of a string) and InStrRev() (which returns the position of a substring starting from the end and moving backwards). This means we can specify everything from the left until the first occurrence of \ when searching backwards through the string.

Answer 2

尝试一下，假设您知道.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 \

Answer 3

假设您仅使用PC，并且人们正在使用自己的副本而不是共享网络副本。我会推荐以下内容。

创建一个名为“Config”的工作表，将包含exe的路径放在那里，然后将其隐藏。
使用FileScriptingObject（'工具'＆gt;'参考'＆gt;'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

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

3 个答案: