Private Function FindAssociatedProgram(ByVal extension As _
    String) As String
Dim temp_title As String
Dim temp_path As String
Dim fnum As Integer
Dim result As String
Dim pos As Integer

    ' Get a temporary file name with this extension.
    GetTempFile extension, temp_path, temp_title

    ' Make the file.
    fnum = FreeFile
    Open temp_path & temp_title For Output As fnum
    Close fnum

    ' Get the associated executable.
    result = Space$(1024)
    FindExecutable temp_title, temp_path, result
    pos = InStr(result, Chr$(0))
    FindAssociatedProgram = Left$(result, pos - 1)

    ' Delete the temporary file.
    Kill temp_path & temp_title
End Function

' Return a temporary file name.
Private Sub GetTempFile(ByVal extension As String, ByRef _
    temp_path As String, ByRef temp_title As String)
Dim i As Integer

    If Left$(extension, 1) <> "." Then extension = "." & _
        extension

    temp_path = Environ("TEMP")
    If Right$(temp_path, 1) <> "\" Then temp_path = _
        temp_path & "\"

    i = 0
    Do
        temp_title = "tmp" & Format$(i) & extension
        If Len(Dir$(temp_path & temp_title)) = 0 Then Exit _
            Do
        i = i + 1
    Loop
End Sub

Private Sub cmdFindProgram_Click()
    lblResult.Caption = _
        FindAssociatedProgram(txtExtension.Text)
End Sub