asked on

How do I find the default application for a file extension in VB

I am after a code in vb that returns the default application for a given file extension.

I need this so that I can then open the file using the shell command

Shell "ApplicationName " & StrFilePath, vbMinimizedFocus

ASKER CERTIFIED SOLUTION

OCDan

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Sheils

ASKER

Where to I get the FindExecutable API

SOLUTION

Paolo Santiangeli

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Paolo Santiangeli

point 6...

Sheils

ASKER

I tried this with no success. This is a copy of the codes that I am running

Private Declare Function FindExecutable Lib "shell32.dll" Alias _
 "FindExecutableA" (ByVal lpFile As String, ByVallpDirectory As String, _
 ByVal lpResult As String) As Long
 
Global objFSO As Object
 
Function SetFileSystemObject()
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
End Function

Function SelectFile() As String
 
    On Error GoTo ExitSelectFile
     
    Dim objFileDialog    As Object
    Set objFileDialog = Application.FileDialog(msoFileDialogFilePicker)
     
    With objFileDialog
     
        .AllowMultiSelect = False
        .Show
          
        Dim varSelectedItem As Variant
 
        For Each varSelectedItem In .SelectedItems
 
            SelectFile = varSelectedItem
          
        Next varSelectedItem
             
   End With
    
ExitSelectFile:
 
Set objFileDialog = Nothing
 
End Function



Function apicFindExecutable(strDataFile As String, strDir As String) As String
  'Resturns exectuable for passed data file.
  Dim lgnApp As Long
  Dim strApp As String
  strApp = Space(260)
  lngapp = FindExecutable(strDataFile, strDir, strApp)
  
  Debug.Print strApp & ":  " & lngapp
  
  If lngapp > 32 Then
    apicFindExecutable = strApp
  Else
    apicFindExecutable = "No matching application."
  End If
  Debug.Print apicFindExecutable
End Function

Function OpenFile()

Dim strFilePath As String, strDataFile As String, strDir As String

strFilePath = SelectFile
Debug.Print strFilePath

SetFileSystemObject

strDataFile = objFSO.getfilename(strFilePath)
Debug.Print strDataFile

strDir = Left(strFilePath, Len(strFilePath) - Len(objFSO.getfilename(strFilePath)))
Debug.Print strDir

apicFindExecutable strDataFile, strDir

'Shell "cmd.exe /c " & strFilePath, vbMaximizedFocus

End Function

Open in new window

Sheils

ASKER

I am trying to find the executable when running the OpenFile function

Sheils

ASKER

I ended up using the code from Access Web:

'************ Code Start **********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long
 
'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized
 
'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
 
'***************Usage Examples***********************
'Open a folder:     ?fHandleFile("C:\TEMP\",WIN_NORMAL)
'Call Email app:    ?fHandleFile("mailto:dash10@hotmail.com",WIN_NORMAL)
'Open URL:          ?fHandleFile("http://home.att.net/~dashish", WIN_NORMAL)
'Handle Unknown extensions (call Open With Dialog):
'                   ?fHandleFile("C:\TEMP\TestThis",Win_Normal)
'Start Access instance:
'                   ?fHandleFile("I:\mdbs\CodeNStuff.mdb", Win_NORMAL)
'****************************************************
 
Function fHandleFile(stFile As String, lShowHow As Long)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
             
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function
'************ Code End **********

Open in new window