Declare Function AssocQueryString Lib "shlwapi.dll" Alias "AssocQueryStringA" _
(Byval flags As Long, Byval pstr As Long, Byval pszAssoc As String, Byval pszExtra As String, _
Byval pszOut As String, Byval pcchOut As Long) As Long
'dont truncate the return string
Const ASSOCF_NOTRUNCATE = &H20
'return the the executable part of command string
Const ASSOCSTR_EXECUTABLE = 2
'actually gets info about rundlls target if applicable
Const ASSOCF_REMAPRUNDLL = &H80
Const S_OK = 0
Const E_POINTER = &H80004003
Function fGetAppPath(Byval strExt As String) As String
'--- Returns the path to an executable or an empty string if an error occurs
'--- Input
' strExt is the three character file extension associated with the executable
Dim lngRtn As Long
Dim lngBuffLen As Long
Dim lngFlags As Long
Dim strAppPath As String
'Check strExt isn't empty
If strExt = vbNullString Then
Exit Function
End If
'Set the flags
lngFlags = ASSOCF_NOTRUNCATE Or ASSOCF_REMAPRUNDLL
'Null terminate the file extension
strExt = "." & strExt & vbNullChar
'Size the buffer for the return value
strAppPath = Space(255)
lngBuffLen = 255
'Get the exe path
lngRtn = AssocQueryString(lngFlags, ASSOCSTR_EXECUTABLE, _
strExt, vbNullString, strAppPath, lngBuffLen)
'Check the result
Select Case lngRtn
Case S_OK
'Success, do nothing
Case E_POINTER
'Buffer was too small - resize it and try again
strAppPath = Space(lngBuffLen)
lngRtn = AssocQueryString(lngFlags, ASSOCSTR_EXECUTABLE, _
strExt, vbNullString, strAppPath, lngBuffLen)
Case Else
'An error occurred - exit
Exit Function
End Select
'Strip the terminating null char and remaining spaces
fGetAppPath = Left$(strAppPath, Instr(1, strAppPath, vbNullChar) -1)
End Function