Option Explicit
      Private Declare Function ShellExecute Lib "shell32.dll" Alias _
      "ShellExecuteA" (ByVal hWnd As Long, ByVal lpszOp As _
      String, ByVal lpszFile As String, ByVal lpszParams As String, _
      ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
      Private Declare Function GetDesktopWindow Lib "user32" () As Long
      Const SW_SHOWNORMAL = 1
      Const SE_ERR_FNF = 2&
      Const SE_ERR_PNF = 3&
      Const SE_ERR_ACCESSDENIED = 5&
      Const SE_ERR_OOM = 8&
      Const SE_ERR_DLLNOTFOUND = 32&
      Const SE_ERR_SHARE = 26&
      Const SE_ERR_ASSOCINCOMPLETE = 27&
      Const SE_ERR_DDETIMEOUT = 28&
      Const SE_ERR_DDEFAIL = 29&
      Const SE_ERR_DDEBUSY = 30&
      Const SE_ERR_NOASSOC = 31&
      Const ERROR_BAD_FORMAT = 11&
      Function OpenDocument(ByVal DocName As String) As Long
          Dim Scr_hDC As Long
          'Scr_hDC = GetDesktopWindow()
          OpenDocument = ShellExecute(Me.hWnd, "Open", DocName, _
          "", "C:\", SW_SHOWNORMAL)
      End Function
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
 
Private Sub File1_DblClick()
Dim r As Long, msg As String
          Dim str As String
          If Right(Dir1.Path, 1) = "\" Then
              str = Dir1.Path & File1.FileName
          Else
              str = Dir1.Path & "\" & File1.FileName
          End If
          Me.Caption = str
          r = OpenDocument(str)
          'If there is an error, the return value is
          'less than or equal to 32
          If r <= 32 Then
              Select Case r
                  Case SE_ERR_FNF
                      msg = "File not found"
                  Case SE_ERR_PNF
                      msg = "Path not found"
                  Case SE_ERR_ACCESSDENIED
                      msg = "Access denied"
                  Case SE_ERR_OOM
                      msg = "Out of memory"
                  Case SE_ERR_DLLNOTFOUND
                      msg = "DLL not found"
                  Case SE_ERR_SHARE
                      msg = "A sharing violation occurred"
                  Case SE_ERR_ASSOCINCOMPLETE
                      msg = "Incomplete or invalid file association"
                  Case SE_ERR_DDETIMEOUT
                      msg = "DDE Time out"
                  Case SE_ERR_DDEFAIL
                      msg = "DDE transaction failed"
                  Case SE_ERR_DDEBUSY
                      msg = "DDE busy"
                  Case SE_ERR_NOASSOC
                      msg = "No association for file extension"
                  Case ERROR_BAD_FORMAT
                      msg = "Invalid EXE file or error in EXE image"
                  Case Else
                      msg = "Unknown error"
              End Select
              MsgBox msg
          End If
End Sub

Private Sub Drive1_Change()
On Error GoTo HandleErrors
Dir1.Path = Drive1.Drive
frmAssociation.Refresh
HandleErrors:
frmAssociation.Refresh
ExitLine:
Exit Sub
End Sub