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.
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.
Option Explicit
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
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.
|
This page last updated: 5-March-2012. |