Visual Basic Programming Code Examples

Visual Basic > API and Miscellaneous Code Examples

Opening, Printing and Emailing documents-files using Shell API

Opening, Printing and Emailing documents-files using Shell API

The following routines illustrate how to use the ShellExecute API to send emails and to open and print documents.

Option Explicit

Public Const SW_HIDE = 0            'Hides the window and activates another window.
Public Const SW_SHOWNORMAL = 1      'Activates and displays a window. If the window is minimized or maximized, Windows restores it
                                    'to its original size and position. An application should specify this flag when displaying the
                                    'window for the first time.
Public Const SW_SHOWMINIMIZED = 2   'Activates the window and displays it as a minimized window.
Public Const SW_SHOWMAXIMIZED = 3   'Maximizes the specified window.
Public Const SW_SHOWNOACTIVATE = 4  'Displays a window in its most recent size and position. The active window remains active.
Public Const SW_SHOW = 5            'Activates the window and displays it in its current size and position.
Public Const SW_SHOWMINNOACTIVE = 7 'Displays the window as a minimized window. The active window remains active.
Public Const SW_SHOWNA = 8          'Displays the window in its current state. The active window remains active.
Public Const SW_SHOWDEFAULT = 10    'Sets the show state based on the SW_ flag specified in the STARTUPINFO structure passed
                                    'to the CreateProcess function by the program that started the application. An application
                                    'should call ShowWindow with this flag to set the initial show state of its main window.

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 GetActiveWindow Lib "user32" () As Long   'Replace with Me.Hwnd in VB

'Purpose     :  Performs an action on a file. The file can be an executable file or a document
'Inputs      :  sFilePath           The path to the document/application.
'               [sVerb]             A string, referred to as a verb, that specifies the action to be performed.
'                                   Commonly used verbs include:
'                                   1. "edit"           Launches an editor and opens the document for editing.
'                                   2. "find"           Initiates a search starting from the specified directory.
'                                   3. "open"           Launches an application. If this file is not an executable file, its associated application is launched.
'                                   4. "print"          Prints the document file.
'                                   5. "properties"     Displays the object's properties.

'               [lShow]             Flags that specify how an application is to be displayed when it is opened. See the SW_ Constants.
'Outputs     :  Returns a value greater than 32 if successful. Values less than or equal to 32 are errors.
'Notes       :  To find which verbs are available for a given file, look in the registry under
'               HKEY_CLASSES_ROOT\CLSID\{object_clsid}\Shell\verb
'Revisions   :  See the function GetShellError for error descriptions

Function ShellEx(ByVal sFilePath As String, Optional sVerb As String = "OPEN", Optional lShow As Long = SW_SHOWDEFAULT, Optional sStartDir As String = "") As Long
    Const clMaxStringLen As Long = 260
    On Error Resume Next
    If Len(Dir$(sStartDir)) = 0 Or Len(sStartDir) = 0 And Left$(sFilePath, 7) <> "mailto:" Then
        sStartDir = CurDir$
    End If

    If Len(sFilePath) > clMaxStringLen Then
        'Check the file path length. If exceed max. limit will get a GPF.
        sFilePath = Left$(sFilePath, clMaxStringLen - 3)
        sFilePath = sFilePath & "..."
    End If    

    ShellEx = ShellExecute(GetActiveWindow, sVerb, sFilePath, vbNullString, sStartDir, lShow)
End Function


'Purpose     :  Returns the error description for the ShellExecute API
'Inputs      :  lErrorCode          The error code.
'Outputs     :  Returns a descriptive error message.


Function GetShellError(lErrorCode As Long) As String
    Const SE_ERR_FNF = 2&, SE_ERR_PNF = 3&
    Const SE_ERR_ACCESSDENIED = 5&, SE_ERR_OOM = 8&
    Const SE_ERR_DLLNOTFOUND = 32&, SE_ERR_SHARE = 26&
    Const SE_ERR_ASSOCINCOMPLETE = 27&, SE_ERR_DDETIMEOUT = 28&
    Const SE_ERR_DDEFAIL = 29&, SE_ERR_DDEBUSY = 30&
    Const SE_ERR_NOASSOC = 31&, ERROR_BAD_FORMAT = 11&

    Select Case lErrorCode
        Case SE_ERR_FNF
            GetShellError = "File not found"
        Case SE_ERR_PNF
            GetShellError = "Path not found"
        Case SE_ERR_ACCESSDENIED
            GetShellError = "Access denied"
        Case SE_ERR_OOM
            GetShellError = "Out of memory"
        Case SE_ERR_DLLNOTFOUND
            GetShellError = "DLL not found"
        Case SE_ERR_SHARE
            GetShellError = "A sharing violation occurred"
        Case SE_ERR_ASSOCINCOMPLETE
            GetShellError = "Incomplete or invalid file association"
        Case SE_ERR_DDETIMEOUT
            GetShellError = "DDE Time out"
        Case SE_ERR_DDEFAIL
            GetShellError = "DDE transaction failed"
        Case SE_ERR_DDEBUSY
            GetShellError = "DDE busy"
        Case SE_ERR_NOASSOC
            GetShellError = "No association for file extension"
        Case ERROR_BAD_FORMAT
            GetShellError = "Invalid EXE file or error in EXE image"
        Case Else
            GetShellError = "Unknown error"
    End Select
End Function


'Demonstration routine
Sub Test()
    Dim lRet As Long
    
    'Print a word document
    lRet = ShellEx("C:\test.doc", "PRINT", SW_HIDE)
    If lRet < 32 Then
        'Failed get error message
        Debug.Print GetShellError(lRet)
    End If
    
    'Open a word document
    lRet = ShellEx("C:\test.doc", "OPEN", SW_HIDE)
    If lRet < 32 Then
        'Failed get error message
        Debug.Print GetShellError(lRet)
    End If
    
    'Send an email
    lRet = ShellEx("mailto:myname@microsoft.com?subject=The subject&body=This Web Site is ace!", "", SW_SHOWNORMAL)
    If lRet < 32 Then
        'Failed get error message
        Debug.Print GetShellError(lRet)
    End If
End Sub