(FindExecutable) - (AssocQueryString) - (IAssocHandler Interface)

[Jaafar Tribak]

In an attempt to answer this question and aftter searching this subject in the last few days, I found that the FindExecutable API function doesn't always work for finding the (.exe) associated with a specific document file. This API function works consistently when applied to some file extensions (such as office documents) but appears to be inconsistent with many other file extensions particularly in Windows 10.

I thought I would post here 3 different methods I arrived at for finding the associated executable (and its path ) so that if one method doesn't work, just try another one... The third method being the most complex but the most consistent.

Workbook demo



* Method(1) FindExecutable API

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
    Private Declare PtrSafe Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#Else
    Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
    Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#End If


Function FindExecutable_With_FindExecutableAPI(DocumetFileExtension As String) As String

    Const MAX_PATH = 260
    Dim sFileName As String, sExecutable As String, lRet As Long

    If Len(DocumetFileExtension) Then
        sFileName = Space(MAX_PATH): sExecutable = Space(MAX_PATH)
        Call GetTempFileName(CurDir, vbNullString, 0&, sFileName)
        sFileName = Application.Trim(sFileName)
        sFileName = Left$(sFileName, Len(sFileName) - 3) & DocumetFileExtension
        On Error Resume Next
            Open sFileName For Output As #1: Close #1
            lRet = FindExecutable(sFileName, vbNullString, sExecutable)
            Kill sFileName
        On Error GoTo 0
        If lRet > 32 Then
            FindExecutable_With_FindExecutableAPI = Left$(sExecutable, InStr(sExecutable, Chr(0)) - 1)
        End If
    End If
   
End Function

* Method(2) AssocQueryString API

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function AssocQueryString Lib "shlwapi.dll" Alias "AssocQueryStringA" (ByVal flags As Long, ByVal str As Long, ByVal pszAssoc As String, ByVal pszExtra As String, ByVal pszOut As String, ByRef pcchOut As Long) As Long
#Else
    Private Declare Function AssocQueryString Lib "shlwapi.dll" Alias "AssocQueryStringA" (ByVal flags As Long, ByVal str As Long, ByVal pszAssoc As String, ByVal pszExtra As String, ByVal pszOut As String, ByRef pcchOut As Long) As Long
#End If


Function FindExecutable_With_AssocQueryStringAPI(ByVal DocumetFileExtension As String) As String

    Const ASSOCSTR_EXECUTABLE = &H2
    Const ASSOCF_IGNOREUNKNOWN = &H400
    Const S_OK As Long = &H0
    Const MAX_PATH = 260
  
    Dim Buffer As String * MAX_PATH
  
    If Len(DocumetFileExtension) Then
        DocumetFileExtension = IIf(Left(DocumetFileExtension, 1) = ".", DocumetFileExtension, "." & DocumetFileExtension)
        If AssocQueryString(ASSOCF_IGNOREUNKNOWN, ASSOCSTR_EXECUTABLE, DocumetFileExtension, vbNullString, Buffer, Len(Buffer)) = S_OK Then
            FindExecutable_With_AssocQueryStringAPI = Application.Trim(Left$(Buffer, Len(Buffer) - 1))
        End If
    End If
End Function

* Method(3) IAssocHandler Interface

Option Explicit

Private Enum ASSOC_FILTER
    ASSOC_FILTER_NONE = &H0
    ASSOC_FILTER_RECOMMENDED = &H1
End Enum

#If VBA7 Then
    Private Declare PtrSafe Function SHAssocEnumHandlers Lib "shell32" (ByVal pszExtra As LongPtr, ByVal afFilter As ASSOC_FILTER, ByVal ppEnumHandler As LongPtr) As Long
    Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
    Private Declare PtrSafe Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare PtrSafe Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
#Else
    Private Declare Function SHAssocEnumHandlers Lib "shell32" (ByVal pszExtra As Long, ByVal afFilter As ASSOC_FILTER, ByVal ppEnumHandler As Long) As Long
    Private Declare Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
    Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
#End If


Function FindExecutable_With_AssocHandlerINTERFACE(ByVal DocumetFileExtension As String) As String

    #If Win64 Then
        Const vTblOffsetFac_32_64 = 2&
        Dim pEnumHandlers As LongLong
        Dim pAssocHandler As LongLong
         Dim pceltFetched As LongLong
        Dim pExecutablePathName As LongLong
    #Else
        Const vTblOffsetFac_32_64 = 1&
        Dim pEnumHandlers As Long
        Dim pAssocHandler As Long
        Dim pceltFetched As Long
        Dim pExecutablePathName As Long
    #End If
   
    Const IEnumAssocHandlers_Next = 12 * vTblOffsetFac_32_64
    Const IAssocHandler_GetName = 12 * vTblOffsetFac_32_64
    Const CC_STDCALL = 4&
    Const S_OK = 0&
   
    Dim Unk As IUnknown

    If Len(DocumetFileExtension) Then
        DocumetFileExtension = IIf(Left(DocumetFileExtension, 1) = ".", DocumetFileExtension, "." & DocumetFileExtension)
        If SHAssocEnumHandlers(StrPtr(DocumetFileExtension), ASSOC_FILTER_RECOMMENDED, VarPtr(Unk)) = S_OK Then
            pEnumHandlers = ObjPtr(Unk)
            If vtblCall(pEnumHandlers, IEnumAssocHandlers_Next, vbLong, CC_STDCALL, 1&, VarPtr(pAssocHandler), VarPtr(pceltFetched)) = S_OK Then
                If vtblCall(pAssocHandler, IAssocHandler_GetName, vbLong, CC_STDCALL, VarPtr(pExecutablePathName)) = S_OK Then
                    FindExecutable_With_AssocHandlerINTERFACE = GetStrFromPtrW(pExecutablePathName)
                End If
            End If
        End If
    End If

End Function


#If Win64 Then
    Private Function vtblCall(ByVal InterfacePointer As LongLong, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant

    Dim vParamPtr() As LongLong
#Else
    Private Function vtblCall(ByVal InterfacePointer As Long, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant

    Dim vParamPtr() As Long
#End If

    If InterfacePointer = 0& Or VTableOffset < 0& Then Exit Function
    If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function

    Dim pIndex As Long, pCount As Long
    Dim vParamType() As Integer
    Dim vRtn As Variant, vParams() As Variant

    vParams() = FunctionParameters()
    pCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
    If pCount = 0& Then
        ReDim vParamPtr(0 To 0)
        ReDim vParamType(0 To 0)
    Else
        ReDim vParamPtr(0 To pCount - 1&)
        ReDim vParamType(0 To pCount - 1&)
        For pIndex = 0& To pCount - 1&
            vParamPtr(pIndex) = VarPtr(vParams(pIndex))
            vParamType(pIndex) = VarType(vParams(pIndex))
        Next
    End If
   
    pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, pCount, vParamType(0), vParamPtr(0), vRtn)
    If pIndex = 0& Then
        vtblCall = vRtn
    Else
        SetLastError pIndex
    End If

End Function


#If Win64 Then
    Private Function GetStrFromPtrW(ByVal Ptr As LongLong) As String
#Else
    Private Function GetStrFromPtrW(ByVal Ptr As Long) As String
#End If

    SysReAllocString VarPtr(GetStrFromPtrW), Ptr

End Function

Usage Demo:

Option Explicit

Sub Test()

    Dim sAssocExecutable As String, vExetensionsArray() As Variant, vExtension As Variant
   
    vExetensionsArray = Array("xls", "wmv", "bmp", "ico", "wav", "dll", "txt", "dat", "jpg", "gif")
   
    For Each vExtension In vExetensionsArray
   
        Debug.Print "Extension : " & CStr(vExtension)
       
        'Method 1
        sAssocExecutable = FindExecutable_With_FindExecutableAPI(CStr(vExtension))
            Debug.Print Space(10) & "Method (1)" & vbLf & Space(20) & "Executable :  " & sAssocExecutable
       
         'Method 2
        sAssocExecutable = FindExecutable_With_AssocQueryStringAPI(CStr(vExtension))
            Debug.Print Space(10) & "Method (2)" & vbLf & Space(20) & "Executable :  " & sAssocExecutable
           
         'Method 3
        sAssocExecutable = FindExecutable_With_AssocHandlerINTERFACE(CStr(vExtension))
            Debug.Print Space(10) & "Method (3)" & vbLf & Space(20) & "Executable :  " & sAssocExecutable
           
        Debug.Print "==================================================="
       
    Next vExtension
   
End Sub

I hope you find this useful.

 

[YasserKhalil]

Amazing my friend. Thanks a lot for the topic.
The question is still there how to specify the path of the application of WhatsApp as an example? I noticed that the code you posted to deal with the extensions and specify the path of the default executable file.

 

[Jaafar Tribak]

The question is still there how to specify the path of the application of WhatsApp as an example?

I am not familiar with WhatsApp but, In theory, if you can figure out which data file extension(s) open by default with the WhatsApp executable then you should be able to use (try) any of the above functions simply by passing to them the data file extension and retrieve the WhatsApp exe path.

 

[YasserKhalil]

I don't think there's a data file extension as this software for chatting (I am not sure in fact). Can the code be modified so as to search by text not extension?

 

[Jaafar Tribak]

I don't think there's a data file extension as this software for chatting (I am not sure in fact). Can the code be modified so as to search by text not extension?

I don't think the following extensions will work but trying them out won't hurt :
.crypt, .crypt5, .crypt6, crypt7, crypt12, .current, .waptt and .db

 

[YasserKhalil]

I tested the extensions and got empty output except for that

Extension : current​

Method (1)​

Executable : C:\Windows\system32\NOTEPAD.EXE​

 

[RoryA]

Given the point of the code Jaafar posted, I'm not really sure why you would try and use it to locate the WhatsApp executable. Why do you need to do that anyway?

 

[YasserKhalil]

@RoryA This was related to a code that I need to locate the path of the whatsapp to be automatic according to the user.

 

[RoryA]

But it's not really related, since this code is specifically designed to find the application associated with a given file extension, and that is not your situation at all. (TBH, I didn't know until today that you could even install WhatsApp on a PC)