Option Explicit



Private Const MAX_PATH = 256



'// Type structure taken fron the C Header file > shellapi.h

'// Minimum operating systems Windows NT 4.0, Windows 95

'typedef struct _SHFILEINFO {

'    HICON hIcon;

'    int iIcon;

'    DWORD dwAttributes;

'    TCHAR szDisplayName[MAX_PATH];

'    TCHAR szTypeName[80];

'} SHFILEINFO;



Private Type SHFILEINFO

    hIcon         As Long

    iIcon         As Long

    dwAttributes  As Long

    szDisplayName As String * MAX_PATH

    szTypeName    As String * 80

End Type





Private Declare Function SHGetFileInfo _

    Lib "Shell32" _

        Alias "SHGetFileInfoA" ( _

            ByVal pszPath As Any, _

            ByVal dwFileAttributes As Long, _

            psfi As SHFILEINFO, _

            ByVal cbFileInfo As Long, _

            ByVal uFlags As Long) _

As Long



'// Retrieve the string that describes the file's type.

'// for example "Microsoft Excel worksheet","Executable file" etc

'// The string is copied to the szTypeName member of the structure specified in psfi.

Const SHGFI_TYPENAME = &H400



Function GetFileDescription(ByVal sPath As String) As String

    Dim FInfo As SHFILEINFO

    

    '// Get the item's attributes

    SHGetFileInfo sPath, 0, FInfo, Len(FInfo), SHGFI_TYPENAME

    '// Read the szTypeName field

    '// Note: When using AppGetOpenFileName the string passed is padded with

    '// 4 Vbnullcharacters @ the beginning so....

    GetFileDescription = Mid(FInfo.szTypeName, 5, InStr(5, FInfo.szTypeName, vbNullChar) - 5)



End Function



Sub GetFileDescp()

Dim strFilename As String



strFilename = Application.GetOpenFilename("All Files (*.*),*.*,All Files (*.*),*.*")

If strFilename = "False" Then Exit Sub



MsgBox "[" & strFilename & "] = " & GetFileDescription(strFilename), vbInformation



End Sub