Private Function getRegValue(sExt As String) As String
Dim lReturn As Long
Dim sSubKey As String
Dim hKeyHandle As Long
Dim sValue As String
Dim lSize As Long
Dim lPos As Long
sSubKey =  "."  & sExt
lSize =  255 
sValue = String(lSize,  0 )
lReturn = RegOpenKey(HKEY_CLASSES_ROOT, sSubKey, hKeyHandle)
If lReturn <>  0  Then Exit Function
lReturn = RegQueryValue(hKeyHandle,  "", sValue, lSize)
If lReturn <> 0  Then
    getRegValue = " "
    Exit Function
End If
If Asc(Mid(sValue, lSize, 1 )) =  0  Then
    sValue = Left(sValue, lSize -  1 )
Else
    sValue = Left(sValue, lSize)
End If
sSubKey = sValue & "\shell\open\command "
lReturn = RegOpenKey(HKEY_CLASSES_ROOT, sSubKey, hKeyHandle)
If lReturn <> 0  Then
    getRegValue = " "
    Exit Function
End If
lSize = 255 
sValue = String(lSize,  0 )
lReturn = RegQueryValue(hKeyHandle, " ", sValue, lSize)
If lReturn <> 0  Then
    getRegValue = " "
    Exit Function
End If
If Asc(Mid(sValue, lSize, 1 )) =  0  Then
    sValue = Left(sValue, lSize -  1 )
Else
    sValue = Left(sValue, lSize)
End If
lPos = InStr(UCase(sValue), "EXE ")
If lPos Then
    getRegValue = Left(sValue, lPos + 2 ) & "  "
    lPos = InStr(getRegValue, Chr(34 ))
    If lPos =  1  Then
        getRegValue = Right(getRegValue, Len(getRegValue) -  1 )
    End If
Else
    getRegValue = ""
End If
End Function

 sApp = getRegValue(sExt)
         If Len(sApp) Then
             On Error Resume Next
             Shell sApp & sfile, vbNormalFocus
             On Error GoTo  0 
          Else
             MsgBox  "NOT PROGRAMM ASSOCIATED WITH "  & sfile
          End If