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
LVL 16
SheilsAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

OCDanCommented:
This link should help, I have used this previously:
VBHelper
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
SheilsAuthor Commented:
Where to I get the FindExecutable API
0
Paolo SantiangeliConsulente InformaticoCommented:
0
Cloud Class® Course: Amazon Web Services - Basic

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

Paolo SantiangeliConsulente InformaticoCommented:
point 6...
0
SheilsAuthor Commented:
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

0
SheilsAuthor Commented:
I am trying to find the executable when running the OpenFile function
0
SheilsAuthor Commented:
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

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.