ThreeWave File Descriptions In VBA

This page describes how to determine the type of a file from its name. For example, you can determine that C:\Book2.xls is an Excel 2003 file.
ShortFadeBar

Introduction

Windows differentiates file types by the extension of the file name. The extension is the text that follows the last period in the file name. For example, C:\Test\Book1.xlsm has the extension .xlsm. Note that the leading period is considered part of the extension. Windows uses information keyed off the extension in the system registry to find out information about the file.

Working with the system registry is difficult and risky. It is easy to corrupt the registry with flawed API calls, and once the registry is corrupt, you will have problems ranging from minor inconveniences and lost default settings all the way up to not being able to start Windows normally. Manipulation of the registry is not for beginners.

The code on this page doesn't write to the registry, so there is no risk of damage to the registry, but it simplifies the registry read operations into nice, VBA-friendly code. The code returns the ProgID and file description for any file extension registered by Windows in the registry. So, given a file name like C:\Test\Book1.xlsm, the code will return the ProgID Excel.SheetMacroEnabled.12 and the description Microsoft Office Excel 2007 Macro-Enabled Workbook. The code passes back the ProgID and descriptions in the variables you pass to the function. The result of the function is a Boolean, where True indicates success and False indicates failure.

The Code

download You can download the bas module file with all the example code on this page.
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modFileDescription
' By Chip Pearson, 6-March-2012, chip@cpearson.com , www.cpearson.com
' This contains the GetFileDescription function that returns the ProgID and
' description of a file based on the filename's extension.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal HKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" ( _
    ByVal HKey As Long, _
    ByVal lpSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    phkResult As Long) As Long
Private Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" ( _
    ByVal HKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    ByRef lpType As Long, _
    ByVal szData As String, _
    ByRef lpcbData As Long) As Long

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKCR = HKEY_CLASSES_ROOT
Private Const REG_SZ As Long = 1&
Private Const KEY_QUERY_VALUE = &H1
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_ACCESS_DENIED = 5&
Private Const ERROR_INVALID_DATA = 13&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const S_OK = &H0
Private Const MAX_DATA_BUFFER_SIZE = 1024


Function GetFileDescription(FileName As String, ByRef ProgID As String, _
        ByRef Description As String) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetFileDescription
' By Chip Pearson, 6-March-2012, chip@cpearson.com
' This function examines the file name's extension and looks it up in
' the system registry to get the ProgID of the type and the
' textual description of the file. This information is passed back
' via the ProgID and Description values. These must be strings.
' The function returns True if successful or False if an error
' occurred. If an error occurred, the contents of ProgID and
' Description are undefined. In any case, the existing content of
' ProgID and Description are destroyed. The file named by FileName
' need not exist.
'
' For example,
'        Dim FileName As String
'        Dim ProgID As String
'        Dim Description As String
'        Dim Result As Boolean
'        FileName = "C:\Test\Book1.xlsm"
'        Result = GetFileDescription(FileName, ProgID, Description)
'        If Result = True Then
'            Debug.Print "OK", FileName, ProgID, Description
'        Else
'            Debug.Print "An error occurred."
'        End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Ext As String
Dim N As Long
Dim Res As Long
Dim HKey As Long

ProgID = vbNullString
Description = vbNullString

N = InStrRev(FileName, ".")
If N = 0 Then
    GetFileDescription = False
    Exit Function
End If

Ext = Mid(FileName, N)
Res = RegOpenKeyEx(HKey:=HKCR, lpSubKey:=Ext, ulOptions:=0&, _
                samDesired:=KEY_QUERY_VALUE, phkResult:=HKey)
If Res <> S_OK Then
    GetFileDescription = False
    Exit Function
End If

ProgID = String$(MAX_DATA_BUFFER_SIZE, vbNullChar)
Res = RegQueryValueExStr(HKey:=HKey, lpValueName:=vbNullString, lpReserved:=0&, _
        lpType:=REG_SZ, szData:=ProgID, lpcbData:=MAX_DATA_BUFFER_SIZE)
If Res <> S_OK Then
    GetFileDescription = False
    Exit Function
End If
RegCloseKey HKey

N = InStr(1, ProgID, Chr(0))
If N > 0 Then
    ProgID = Left(ProgID, N - 1)
End If

Res = RegOpenKeyEx(HKey:=HKCR, lpSubKey:=ProgID, ulOptions:=0&, _
            samDesired:=KEY_QUERY_VALUE, phkResult:=HKey)
If Res <> S_OK Then
    GetFileDescription = False
    Exit Function
End If
Description = String(MAX_DATA_BUFFER_SIZE, vbNullChar)

Res = RegQueryValueExStr(HKey:=HKey, lpValueName:=vbNullString, _
            lpReserved:=0&, lpType:=REG_SZ, szData:=Description, _
            lpcbData:=MAX_DATA_BUFFER_SIZE)
            
If Res <> S_OK Then
    GetFileDescription = False
    Exit Function
End If
RegCloseKey HKey

N = InStr(1, Description, Chr(0))
If N > 0 Then
    Description = Left(Description, N - 1)
End If
Description = Replace(Description, Chr(0), vbNullString)

GetFileDescription = True

End Function

You can then call this function with code like the following:

    Dim FileName As String
    Dim ProgID As String
    Dim Description As String
    Dim Result As Boolean
    FileName = "C:\Test\Book1.xlsm"
    Result = GetFileDescription(FileName, ProgID, Description)
    If Result = True Then
        Debug.Print "OK", FileName, ProgID, Description
    Else
        Debug.Print "Not OK. Error occurred."
    End If

The file named by FileName need not exist, so you can get information about any extension by using a.ext as the filename, where ext is the extension in question.

download You can download the bas module file with all the example code on this page.
ShortFadeBar
LastUpdate This page last updated: 5-March-2012.