使用 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_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\WhatsApp.exe\")
End Sub

Answer 1

你可以试试这个

 Sub test()
 Dim WSHShell
 Set WSHShell = CreateObject("WScript.Shell")
 MsgBox WSHShell.RegRead("HKEY_CLASSES_ROOT\whatsapp\shell\open\command\")
 End Sub

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

Get installed program (WhatsApp) path using VBA

excel

vba

whatsapp