Thread: Vb Programing
View Single Post
Old 02-19-2007, 07:34 AM   #6 (permalink)
Stormdev
 
Newb Techie

Join Date: Dec 2006

Posts: 21

Stormdev

Default

The ShellExecute API function is a much better way of starting applications than VB's built in Shell command.

It allows you to specify file names or internet resources as the file to shell, and will automatically find the associated executable and start it for you.

Essentially its the same function as called by the Start->Run box

Code:
Private Declare Function ShellExecute 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 

Private Declare Function ShellExecuteForExplore Lib "shell32.dll" Alias "ShellExecuteA" _
  (ByVal hWnd As Long, ByVal lpOperation As String, _   ByVal lpFile As String, lpParameters As Any, _
  lpDirectory As Any, ByVal nShowCmd As Long) As Long 

Public Enum EShellShowConstants 
    essSW_HIDE = 0 
    essSW_MAXIMIZE = 3 
    essSW_MINIMIZE = 6 
    essSW_SHOWMAXIMIZED = 3 
    essSW_SHOWMINIMIZED = 2 
    essSW_SHOWNORMAL = 1 
    essSW_SHOWNOACTIVATE = 4 
    essSW_SHOWNA = 8 
    essSW_SHOWMINNOACTIVE = 7 
    essSW_SHOWDEFAULT = 10 
    essSW_RESTORE = 9 
    essSW_SHOW = 5 
End Enum 

Private Const ERROR_FILE_NOT_FOUND = 2& 
Private Const ERROR_PATH_NOT_FOUND = 3& 
Private Const ERROR_BAD_FORMAT = 11& 
Private Const SE_ERR_ACCESSDENIED = 5        ' access denied 
Private Const SE_ERR_ASSOCINCOMPLETE = 27 
Private Const SE_ERR_DDEBUSY = 30 
Private Const SE_ERR_DDEFAIL = 29 
Private Const SE_ERR_DDETIMEOUT = 28 
Private Const SE_ERR_DLLNOTFOUND = 32 
Private Const SE_ERR_FNF = 2                ' file not found 
Private Const SE_ERR_NOASSOC = 31 
Private Const SE_ERR_PNF = 3                ' path not found 
Private Const SE_ERR_OOM = 8                ' out of memory 
Private Const SE_ERR_SHARE = 26 


Public Function ShellEx( _ 
        ByVal sFIle As String, _ 
        Optional ByVal eShowCmd As EShellShowConstants = essSW_SHOWDEFAULT, _ 
        Optional ByVal sParameters As String = "", _ 
        Optional ByVal sDefaultDir As String = "", _ 
        Optional sOperation As String = "open", _ 
        Optional Owner As Long = 0 _ 
    ) As Boolean 
Dim lR As Long 
Dim lErr As Long, sErr As Long 
    If (InStr(UCase$(sFIle), ".EXE") <> 0) Then 
        eShowCmd = 0 
    End If 
    On Error Resume Next 
    If (sParameters = "") And (sDefaultDir = "") Then 
        lR = ShellExecuteForExplore(Owner, sOperation, sFIle, 0, 0, essSW_SHOWNORMAL) 
    Else 
        lR = ShellExecute(Owner, sOperation, sFIle, sParameters, sDefaultDir, eShowCmd) 
    End If 
    If (lR < 0) Or (lR > 32) Then 
        ShellEx = True 
    Else 
        ' raise an appropriate error: 
        lErr = vbObjectError + 1048 + lR 
        Select Case lR 
        Case 0 
            lErr = 7: sErr = "Out of memory" 
        Case ERROR_FILE_NOT_FOUND 
            lErr = 53: sErr = "File not found" 
        Case ERROR_PATH_NOT_FOUND 
            lErr = 76: sErr = "Path not found" 
        Case ERROR_BAD_FORMAT 
            sErr = "The executable file is invalid or corrupt" 
        Case SE_ERR_ACCESSDENIED 
            lErr = 75: sErr = "Path/file access error" 
        Case SE_ERR_ASSOCINCOMPLETE 
            sErr = "This file type does not have a valid file association." 
        Case SE_ERR_DDEBUSY 
            lErr = 285: sErr = "The file could not be opened because the target application is busy. Please try again in a moment." 
        Case SE_ERR_DDEFAIL 
            lErr = 285: sErr = "The file could not be opened because the DDE transaction failed. Please try again in a moment." 
        Case SE_ERR_DDETIMEOUT 
            lErr = 286: sErr = "The file could not be opened due to time out. Please try again in a moment." 
        Case SE_ERR_DLLNOTFOUND 
            lErr = 48: sErr = "The specified dynamic-link library was not found." 
        Case SE_ERR_FNF 
            lErr = 53: sErr = "File not found" 
        Case SE_ERR_NOASSOC 
            sErr = "No application is associated with this file type." 
        Case SE_ERR_OOM 
            lErr = 7: sErr = "Out of memory" 
        Case SE_ERR_PNF 
            lErr = 76: sErr = "Path not found" 
        Case SE_ERR_SHARE 
            lErr = 75: sErr = "A sharing violation occurred." 
        Case Else 
            sErr = "An error occurred occurred whilst trying to open or print the selected file." 
        End Select 
                
        Err.Raise lErr, , App.EXEName & ".GShell", sErr 
        ShellEx = False 
    End If

End Function
Call the ShellEx function as in the following:

To open a the user's browser at a particular internet site
ShellEx "http://www.dogma.demon.co.uk", , , , , Me.hWnd

To print a document
ShellEx "C:\My Documents\Music\Brown Paper Bag.doc", , , , "print", Me.hWnd

To explore from a folder
ShellEx "C:\My Documents\Music", , , , "explore", Me.hWnd
Stormdev is offline