Binaryworld - How to open a file with Wordpad or Notepad ... [ VB -> Shell ]

I tried to find sourcecode which allows me to open a file with any extension with Wordpad and Notepad. And finally I came up with this solution.

Happy Programming....

Click here to copy the following block

Option Explicit
Private Declare Function FindExecutable Lib "shell32.dll" _
Alias "FindExecutableA" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal sResult As String) As Long

Private Sub Command1_Click()

  OpenWithWordPad "d:\t1.txt"

  OpenWithNotePad "d:\t1.txt"

End Sub

Public Function OpenWithWordPad(strPath As String) As Boolean
  Dim lRet As Long
  lRet = Shell(AssociatedEXE("WRI") & " " _
    & strPath, vbNormalFocus)
End Function

Public Function OpenWithNotePad(strPath As String) As Boolean
  Dim lRet As Long
  lRet = Shell(AssociatedEXE("TXT") & " " _
    & strPath, vbNormalFocus)
End Function

Public Function AssociatedEXE(Ext As String) As String
Dim iFN             As Integer
Dim lRet             As Long
Dim szResult           As String
Dim szTmpFile          As String
Const MAX_PATH          As Long = 260
Const FE_SUCCESS         As Long = 32
'-------------------------------------------------
On Error GoTo errAssociatedEXE
szResult = Space$(MAX_PATH)
iFN = FreeFile
szTmpFile = HomeDirectory() & "AE_TMP." & Ext
If FileExists(szTmpFile) Then
   Kill (szTmpFile): DoEvents
End If
Open szTmpFile For Random As #iFN
Close #iFN: DoEvents
lRet = FindExecutable(szTmpFile, "", szResult)
If (lRet >= FE_SUCCESS) Then
   lRet = InStr(szResult, Chr$(0))
   If (lRet > 0) Then
     szResult = Left$(szResult, lRet - 1)
   End If
End If
szResult = Trim$(szResult)
If FileExists(szTmpFile) Then
   Kill (szTmpFile): DoEvents
End If
AssociatedEXE = szResult
Exit Function
errAssociatedEXE:
Close #iFN
Resume Next
End Function

Public Function HomeDirectory() As String
  HomeDirectory = App.Path & IIf(Right$(App.Path, 1) = "\", "", "\")
End Function

Public Function FileExists(ByVal szFileName As String) As Boolean
' ///////////////////////////////////////////////////
' Purpose: See function name            '/
' Parameters: String containing file name     '/
' Return Value: True/False             '/
'////////////////////////////////////////////////////
Dim AttrRet     As Integer
Dim bIsDirectory  As Boolean
'------------------------------------------------
On Error Resume Next
AttrRet = GetAttr(szFileName)
If Err.Number Then
   Err.Clear
   FileExists = False
Else
   bIsDirectory = CBool((AttrRet And vbDirectory) = vbDirectory)
   If (bIsDirectory = False) Then
     FileExists = True
   Else
     FileExists = False
   End If
End If
End Function