如何找到特定程序的安裝目錄？

我已經成功編寫了一些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

如何找到特定程序的安裝目錄？

回答

相關問題