使用VBA获取安装程序(WhatsApp)路径

Question

我正在尝试检测已安装的whatsapp的路径，我发现此代码适用于excel.exe但不适用于WhatsApp.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:"

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
Sub ExampleUse()
Dim x As String
x = "excel.exe"
Debug.Print GetInstallDirectory(x)
End Sub

如何使此代码用于检查WhatsApp.exe的路径？

我也尝试了这样一种适用于 excel 的代码.exe但不适用于 WhatsApp

Sub vv()
Dim WSHShell
Set WSHShell = CreateObject("WScript.Shell")
'MS Excel
MsgBox WSHShell.RegRead("HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionApp PathsWhatsApp.exe")
End Sub

Answer 1

你可以试试这个

Sub test()
Dim WSHShell
Set WSHShell = CreateObject("WScript.Shell")
MsgBox WSHShell.RegRead("HKEY_CLASSES_ROOTwhatsappshellopencommand")
End Sub