ThreeWave File Extensions And Their Implications In VBA Coding

This page describes how the Windows Hide File Extensions setting affects code in Excel.
ShortFadeBar

Introduction

A file extension is a three or four character code, preceded by a period, that follows the proper name of a file. For example, the extension of a file named Book1.xls is xls. Windows uses the file extension to determine what program is to be used to open a file. The System Registry, a database of configuration data maintained by Windows, contains an entry for the xls extension that specifies that Excel is to be used to open the file. It is by the use of the extension that Windows knows to launch Excel, rather than, say, Word, to open an xls file. If you delete or change the extension of an existing file, Windows can no longer determine the appropriate program to launch when opening the file. This can render a file unusable if the user does not know what an extension is and how it is associated with a program. Because of this potential problem and perceived loss of data, Windows by default hides file extensions in Explorer windows. For example, the name of the file Book1.xls is displayed as Book1, without the xls extension.

The hide extensions setting can be changed from the Folder Options dialog box available from any Windows Explorer window. The options dialog is shown below.

HideExtensions

It is worth noting that enabling the hide extensions setting to hide file extensions can make you more vulnerable to virus or trojan horse files. This is due to the way users behave, not to anything intrinsic to Windows. A virus writer may name a file SomeName.jpg.exe. If the hide extensions setting is enabled, the exe extension is hidden and the name of the file SomeName.jpg is displayed in Explorer windows. Most users know that jpg files are innocuous and, seeing the jpg extension, assume that SomeFile.jpg is a harmless image file. When the user clicks on the file to open it, Windows sees the exe extension and executes the program, unleashing potential destruction upon the unwary user.

The hide extensions setting affects Excel and VBA code in two ways. First, it affects how you can refer to workbooks in the Workbooks object. Second, it affects how you can use the Caption property of a Window in a call to the FindWindowEx API function.

SectionBreak

The Workbooks Collection Object

If the hide extensions setting is not in effect (meaning that extensions are indeed displayed in Windows), you must include the xls extension when you reference a workbook in the Workbooks collection. For example, if you have open a workbook named Book1.xls, you must use

Workbooks("Book1.xls").Activate

rather than

Workbooks("Book1").Activate

to refer to the Book1 workbook. The second line of code above, without the xls extension, will fail with an error 9, Subscript Out Of Range, because there is no workbook with the name Book1. If the hide extensions setting is effect, you can omit the xls extension and use either of the following lines of code.

Workbooks("Book1").Activate

Workbooks("Book1.xls").Activate

These lines of code assume that you do not have open both an unsaved workbook with the name Book1 and a saved workbook with the name Book1.xls. With the hide extensions setting enabled (so that extensions are hidden in Windows), the two lines of code above are functionally equivalent. As a matter of good programming practice, you should always include the xls extension in a workbook name. This ensures that you reference the correct workbook regardless of the value of the hide extensions property.

SectionBreak

The FindWindowEx API Function

The second effect of the hide extensions setting is more subtle and can be much harder to debug if you don't know what to look for. Advanced level programming in Excel often makes use of the Windows Application Programmatic Interface (API) function libraries, and one of the more common API functions is the FindWindowEx function. This is used to find the window handle (HWnd) of a window, using the caption of the window as an identifier. The Caption property of a Window object returns the workbook name including the xls extension, regardless of the value of the hide extensions setting in Windows. For example, the Caption returns Book1.xls, not Book1, even if extensions are hidden and do not appear in the title bar of the window. This is done, I assume, to allow Excel to have separate open windows for an unsaved Book1, a saved Book1.xls file, a Book1.xlt template file and a Book1.csv CSV file.

The string passed to the FindWindowEx function as a window text value requires that the file extension be removed if the Windows hide extensions setting is enabled. For example, if the hide extensions setting is enabled so that extensions are not displayed, a call to FindWindowEx using the window text Book1.xls will resuling with a No Window Found value. You must strip the xls extension from the Caption before passing it to FindWindowEx function.

The current value of the Windows hide extensions setting is stored in the System Registry, in the named value HideFileExt under the key:

HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced

The code described on this page and available in downloadable module file includes a function named DoesWindowsHideFileExtensions that reads the registry value and returns TRUE if the hide extensions setting is enabled (extensions are hidden) or FALSE if the hide extensions setting is disabled (extensions are visible).

The declaration of the DoesWindowsHideFileExtensions is as follows:

    Function DoesWindowsHideFileExtensions() As Boolean

The function takes no input parameters and returns simply TRUE or FALSE.

The module file also contains a function named WindowCaption that returns the Caption of an Excel.Window object, with the xls extension removed if required by the value of the hide extensions setting. The function declaration is

    Function WindowCaption(W As Excel.Window) As String

The parameter W is a reference to an Excel.Window object, and the function returns the Caption value of the Window with the extension removed if necessary.

The module also contains a function named WindowHWnd that returns the handle of specified window. That function's declaration is

    Function WindowHWnd(W As Excel.Window) As Long

where W is a reference to an Excel.Window object. The result of the function is the HWnd of the Window or 0 if an error occurred. The WindowHWnd function will work correctly regardless of the value of the hide extensions setting.

You can download the modWindowCaption module here. The complete code is shown below.

This page last updated: 15-March-2008

Option Explicit
Option Compare Text
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modWindowCaption
' By Chip Pearson, 15-March-2008, chip@cpearson.com, www.cpearson.com
' http://www.cpearson.com/Excel/FileExtensions.aspx
'
' This module contains code for working with Excel.Window captions. This code
' is necessary if you are going to use the FindWindowEx API call to get the
' HWnd of an Excel.Window.  Windows has a property called "Hide extensions of
' known file types". If this setting is TRUE, the file extension is not displayed
' (e.g., "Book1.xls" is displayed as just "Book1"). However, the Caption of an
' Excel.Window always includes the ".xls" file extension, regardless of the hide
' extensions setting. FindWindowEx requires that the ".xls" extension be removed
' if the "hide extensions" setting is True.
'
' This module contains a function named DoesWindowsHideFileExtensions, which returns
' TRUE if Windows is hiding file extensions or FALSE if Windows is not hiding file
' extensions. This is determined by a registry key. The module also contains a
' function named WindowCaption that returns the Caption of a specified Excel.Window
' with the ".xls" removed if necessary. The string returned by this function
' is suitable for use in FindWindowEx regardless of the value of the Windows
' "Hide Extensions" setting.
'
' This module also contains a function named WindowHWnd which returns the HWnd of
' a specified Excel.Window object. This function works regardless of the value of the
' Windows "Hide Extensions" setting.
'
' This module also includes the functions WindowText and WindowClassName which are
' just wrappers for the GetWindowText and GetClassName API functions.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, _
    ByVal hWnd2 As Long, _
    ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
    ByVal HWnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" 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 RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
    ByVal HKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    LPType As Long, _
    LPData As Any, _
    lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal HKey As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
    ByVal HWnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long

Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_CLASSES_ROOT  As Long = &H80000000
Private Const HKEY_CURRENT_CONFIG  As Long = &H80000005
Private Const HKEY_DYN_DATA  As Long = &H80000006
Private Const HKEY_PERFORMANCE_DATA  As Long = &H80000004
Private Const HKEY_USERS  As Long = &H80000003
Private Const KEY_ALL_ACCESS  As Long = &H3F
Private Const ERROR_SUCCESS  As Long = 0&
Private Const HKCU  As Long = HKEY_CURRENT_USER
Private Const HKLM  As Long = HKEY_LOCAL_MACHINE

Private Enum REG_DATA_TYPE
    REG_DATA_TYPE_DEFAULT = 0   
    REG_INVALID = -1            
    REG_SZ = 1                  
    REG_DWORD = 4               
End Enum

Private Const C_EXCEL_APP_CLASSNAME = "XLMain"
Private Const C_EXCEL_DESK_CLASSNAME = "XLDesk"
Private Const C_EXCEL_WINDOW_CLASSNAME = "EXCEL7"



Function DoesWindowsHideFileExtensions() As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DoesWindowsHideFileExtensions
' This function looks in the registry key
'   HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced
' for the value named "HideFileExt" to determine whether the Windows Explorer
' setting "Hide Extensions Of Known File Types" is enabled. This function returns
' TRUE if this setting is in effect (meaning that Windows displays "Book1" rather
' than "Book1.xls"), or FALSE if this setting is not in effect (meaning that Windows
' displays "Book1.xls").
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Res As Long
Dim RegKey As Long
Dim V As Long

Const KEY_NAME = "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced"
Const VALUE_NAME = "HideFileExt"

''''''''''''''''''''''''''''''''''''''''''''''''''
' Open the registry key to get a handle (RegKey).
'''''''''''''''''''''''''''''''''''''''''''''''''' 
Res = RegOpenKeyEx(HKey:=HKCU, _
                    lpSubKey:=KEY_NAME, _
                    ulOptions:=0&, _
                    samDesired:=KEY_ALL_ACCESS, _
                    phkResult:=RegKey)

If Res <> ERROR_SUCCESS Then
    Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the value of the "HideFileExt" named value.
''''''''''''''''''''''''''''''''''''''''''''''''''
Res = RegQueryValueEx(HKey:=RegKey, _
                    lpValueName:=VALUE_NAME, _
                    lpReserved:=0&, _
                    LPType:=REG_DWORD, _
                    LPData:=V, _
                    lpcbData:=Len(V))

If Res <> ERROR_SUCCESS Then
    RegCloseKey RegKey
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''''
' Close the key and return the result.
''''''''''''''''''''''''''''''''''''''''''''''''''
RegCloseKey RegKey
DoesWindowsHideFileExtensions = (V <> 0)

End Function



Function WindowCaption(W As Excel.Window) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WindowCaption
' This returns the Caption of the Excel.Window W with the ".xls" extension removed
' if required. The string returned by this function is suitable for use by
' the FindWindowEx API regardless of the value of the Windows "Hide Extensions"
' setting.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

Dim HideExt As Boolean
Dim Cap As String
Dim Pos As Long

HideExt = DoesWindowsHideFileExtensions()
Cap = W.Caption
If HideExt = True Then
    Pos = InStrRev(Cap, ".")
    If Pos > 0 Then
        Cap = Left(Cap, Pos - 1)
    End If
End If

WindowCaption = Cap

End Function



Function WindowHWnd(W As Excel.Window) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WindowHWnd
' This returns the HWnd of the Window referenced by W.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

Dim AppHWnd As Long
Dim DeskHWnd As Long
Dim WHWnd As Long
Dim Cap As String

AppHWnd = Application.HWnd
DeskHWnd = FindWindowEx(AppHWnd, 0&, C_EXCEL_DESK_CLASSNAME, vbNullString)
If DeskHWnd > 0 Then
    Cap = WindowCaption(W)
    WHWnd = FindWindowEx(DeskHWnd, 0&, C_EXCEL_WINDOW_CLASSNAME, Cap)
End If
WindowHWnd = WHWnd

End Function



Function WindowText(HWnd As Long) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WindowText
' This just wraps up GetWindowText.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    Dim S As String
    Dim N As Long
    N = 255
    S = String$(N, vbNullChar)
    N = GetWindowText(HWnd, S, N)
    If N > 0 Then
        WindowText = Left(S, N)
    Else
        WindowText = vbNullString
    End If
End Function



Function WindowClassName(HWnd As Long) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WindowClassName
' This just wraps up GetClassName.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
    Dim S As String
    Dim N As Long
    N = 255
    S = String$(N, vbNullChar)
    N = GetClassName(HWnd, S, N)
    If N > 0 Then
        WindowClassName = Left(S, N)
    Else
        WindowClassName = vbNullString
    End If

End Function
-->