Professional Excel Development [Electronic resources] : The Definitive Guide to Developing Applications Using Microsoft® Excel and VBA® نسخه متنی

Working with the File System and Network

The procedures included in this section can be found in the MFileSys module of the API Examples.xls workbook.

Finding the User ID

Excel has its own user name property, but does not tell us the user's network logon ID. This ID is often required in Excel applications for security validation, auditing, logging change history and so on. It can be retrieved using the API call shown in Listing 9-10.

Listing 9-10. Reading the User's Login ID

Private Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" _
(ByVal lpBuffer As String, _
ByRef nSize As Long) As Long
'Get the user's login ID
Function UserName() As String
'A buffer that the API function fills with the login name
Dim sBuffer As String * 255
'Variable to hold the length of the buffer
Dim lStringLength As Long
'Initialize to the length of the string buffer
lStringLength = Len(sBuffer)
'Call the API function, which fills the buffer
'and updates lStringLength with the length of the login ID,
'including a terminating null - vbNullChar - character
GetUserName sBuffer, lStringLength
If lStringLength > 0 Then
'Return the login id, stripping off the final vbNullChar
UserName = Left$(sBuffer, lStringLength - 1)
End If
End Function

Buffers

Every API function that returns textual information, such as the user name, does so by using a buffer that we provide. A buffer comprises a String variable initialized to a fixed size and a Long variable to tell the function how big the buffer is. When the function is called, it writes the text to the buffer (including a final Null character) and (usually) updates the length variable with the number of characters written. (Some functions return the text length as the function's result instead of updating the variable.) We can then look in the buffer for the required text. Note that VBA stores strings in a very different way than the API functions expect, so whenever we pass strings to API functions, VBA does some conversion for us behind the scenes. For this to work properly, we always pass strings by value (ByVal) to API functions, even when the function updates the string. Some people prefer to ignore the buffer length information, looking instead for the first vbNullChar character in the buffer and assuming that's the end of the retrieved string, so you may encounter usage like that shown in Listing 9-11.

Listing 9-11. Using a Buffer, Ignoring the Buffer Length Variable

'Get the user's login ID, without using the buffer length
Function UserName2() As String
Dim sBuffer As String * 255
GetUserName sBuffer, 255
UserName2 = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End Function

Changing to a UNC Path

VBA's intrinsic ChDrive and ChDir statements can be used to change the active path prior to using Application.GetOpenFilename, such that the dialog opens with the correct path preselected. Unfortunately, that can only be used to change the active path to local folders or network folders that have been mapped to a drive letter. Note that once set, the VBA CurDir function will return a UNC path. We need to use API functions to change the folder to a network path of the form \\server\share\path, as shown in Listing 9-12. In practice, the SetCurDir API function is one of the few that can be called directly from your code.

Listing 9-12. Changing to a UNC Path

Private Declare Function SetCurDir Lib "kernel32" _
Alias "SetCurrentDirectoryA" _
(ByVal lpPathName As String) As Long
'Change to a UNC Directory
Sub ChDirUNC(ByVal sPath As String)
Dim lReturn As Long
'Call the API function to set the current directory
lReturn = SetCurDir(sPath)
'A zero return value means an error
If lReturn = 0 Then
Err.Raise vbObjectError + 1, "Error setting path."
End If
End Sub

Locating Special Folders

Windows maintains a large number of special folders that relate to either the current user or the system configuration. When a user is logged in to Windows with relatively low privileges, such as the basic User account, it is highly likely that the user will only have full access to his personal folders, such as his My Documents folder. These folders can usually be found under C:\Documents and Settings\UserName, but could be located anywhere. We can use an API function to give us the correct paths to these special folders, using the code shown in Listing 9-13. Note that this listing contains a subset of all the possible folder constants. The full list can be found by searching MSDN for "CSIDL Values." The notable exception from this list is the user's Temp folder, which can be found by using the GetTempPath function. Listing 9-13 includes a special case for this folder, so that it can be obtained through the same function.

Listing 9-13. Locating a Windows Special Folder

Private Declare Function SHGetFolderPath Lib "shell32" _
Alias "SHGetFolderPathA" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, _
ByVal hToken As Long, ByVal dwFlags As Long, _
ByVal pszPath As String) As Long
Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
'More Commonly used CSIDL values.
'For the full list, search MSDN for "CSIDL Values"
Private Const CSIDL_PROGRAMS As Long = &H2
Private Const CSIDL_PERSONAL As Long = &H5
Private Const CSIDL_FAVORITES As Long = &H6
Private Const CSIDL_STARTMENU As Long = &HB
Private Const CSIDL_MYDOCUMENTS As Long = &HC
Private Const CSIDL_MYMUSIC As Long = &HD
Private Const CSIDL_MYVIDEO As Long = &HE
Private Const CSIDL_DESKTOPDIRECTORY As Long = &H10
Private Const CSIDL_APPDATA As Long = &H1A
Private Const CSIDL_LOCAL_APPDATA As Long = &H1C
Private Const CSIDL_INTERNET_CACHE As Long = &H20
Private Const CSIDL_WINDOWS As Long = &H24
Private Const CSIDL_SYSTEM As Long = &H25
Private Const CSIDL_PROGRAM_FILES As Long = &H26
Private Const CSIDL_MYPICTURES As Long = &H27
'Constants used in the SHGetFolderPath call
Private Const CSIDL_FLAG_CREATE As Long = &H8000&
Private Const SHGFP_TYPE_CURRENT = 0
Private Const SHGFP_TYPE_DEFAULT = 1
Private Const MAX_PATH = 260
'Public enumeration to give friendly names for the CSIDL values
Public Enum SpecialFolderIDs
sfAppDataRoaming = CSIDL_APPDATA
sfAppDataNonRoaming = CSIDL_LOCAL_APPDATA
sfStartMenu = CSIDL_STARTMENU
sfStartMenuPrograms = CSIDL_PROGRAMS
sfMyDocuments = CSIDL_PERSONAL
sfMyMusic = CSIDL_MYMUSIC
sfMyPictures = CSIDL_MYPICTURES
sfMyVideo = CSIDL_MYVIDEO
sfFavorites = CSIDL_FAVORITES
sfDesktopDir = CSIDL_DESKTOPDIRECTORY
sfInternetCache = CSIDL_INTERNET_CACHE
sfWindows = CSIDL_WINDOWS
sfWindowsSystem = CSIDL_SYSTEM
sfProgramFiles = CSIDL_PROGRAM_FILES
'There is no CSIDL for the temp path,
'so we need to give it a dummy value
'and treat it differently in the function
sfTemporary = &HFF
End Enum
'Get the path for a Windows special folder
Public Function SpecialFolderPath( _
ByVal uFolderID As SpecialFolderIDs) As String
'Create a buffer of the correct size
Dim sBuffer As String * MAX_PATH
Dim lResult As Long
If uFolderID = sfTemporary Then
'Use GetTempPath for the temporary path
lResult = GetTempPath(MAX_PATH, sBuffer)
'The GetTempPath call returns the length and a
'trailing \ which we remove for consistency
SpecialFolderPath = Left$(sBuffer, lResult - 1)
Else
'Call the function, passing the buffer
lResult = SHGetFolderPath(0, _
uFolderID + CSIDL_FLAG_CREATE, 0, _
SHGFP_TYPE_CURRENT, sBuffer)
'The SHGetFolderPath function doesn't give us a
'length, so look for the first vbNullChar
SpecialFolderPath = Left$(sBuffer, _
InStr(sBuffer, vbNullChar) - 1)
End If
End Function

The observant among you might have noticed that we've now come across all three ways in which buffers are filled by API functions:

GetUserName returns the length of the text by modifying the input parameter.

GetTempPath returns the length of the text as the function's return value.

SHGetFolderPath doesn't return the length at all, so we search for the first vbNullChar.

Deleting a File to the Recycle Bin

The VBA Kill statement is used to delete a file, but does not send it to the recycle bin for potential recovery by the user. To send a file to the recycle bin, we need to use the SHFileOperation function, as shown in Listing 9-14:

Listing 9-14. Deleting a File to the Recycle Bin

'Structure to tell the SHFileOperation function what to do
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" _
(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40
'Delete a file, sending it to the recycle bin
Sub DeleteToRecycleBin(ByVal sFile As String)
Dim uFileOperation As SHFILEOPSTRUCT
Dim lReturn As Long
'Fill the UDT with information about what to do
With FileOperation
.wFunc = FO_DELETE
.pFrom = sFile
.pTo = vbNullChar
.fFlags = FOF_SILENT + FOF_NOCONFIRMATION + _
FOF_ALLOWUNDO
End With
'Pass the UDT to the function
lReturn = SHFileOperation(FileOperation)
If lReturn <> 0 Then
Err.Raise vbObjectError + 1, "Error deleting file."
End If
End Sub

There are two things to note about this function. First, the function uses a user-defined type to tell it what to do, instead of the more common method of having multiple input parameters. Second, the function returns a value of zero to indicate success. If you recall the SetCurDir function in Listing 9-12, it returns a value of zero to indicate failure! The only way to know which to expect is to check the Return Values section of the function's information page on MSDN.

Browsing for a Folder

All versions of Excel have included the GetOpenFilename and GetSaveAsFilename functions to allow the user to select a filename to open or save. Excel 2002 introduced the common Office FileDialog object, which can be used to browse for a folder, using the code shown in Listing 9-15, which results in the dialog shown in Figure 9-3.

Listing 9-15. Using Excel 2002's FileDialog to Browse for a Folder

'Browse for a folder, using the Excel 2002 FileDialog
Sub BrowseForFolder()
Dim fdBrowser As FileDialog
'Get the File Dialog object
Set fdBrowser = Application.FileDialog(msoFileDialogFolderPicker)
With fdBrowser
'Initialize it
.Title = "Select Folder"
.InitialFileName = "c:\"
'Display the dialog
If .Show Then
MsgBox "You selected " & .SelectedItems(1)
End If
End With
End Sub

Figure 9-3. The Standard Office 2002 Folder Picker Dialog

[View full size image]

We consider this layout far too complicated, when all we need is a simple tree view of the folders on the computer. We can use API functions to show the standard Windows Browse for folder dialog shown in Figure 9-4, which our users tend to find much easier to use. The Windows dialog also gives us the option to display some descriptive text to tell our users what they should be selecting.

Figure 9-4. The Standard Windows Folder Picker Dialog

Callbacks

So far, every function we've encountered just does its thing and returns its result. However, a range of API functions (including the SHBrowseForFolder function that we're about to use) interact with the calling program while they're working. This mechanism is known as a callback. Excel 2000 added a VBA function called AddressOf, which provides the address in memory where a given procedure can be found. This address is passed to the API function, which calls back to the procedure found at that address as required. For example, the EnumWindows function iterates through all the top-level windows, calling back to the procedure with the details of each window it finds. Obviously, the procedure being called must be defined exactly as Windows expects it to be so the API function can pass it the correct number and type of parameters.

The SHBrowseForFolder function uses a callback to tell us when the dialog is initially shown, enabling us to set its caption and initial selection, and each time the user selects a folder, enabling us to check the selection and enable/disable the OK button. The full text for the function is contained in the MBrowseForFolder module of the API Examples.xls workbook and a slightly simplified version is shown in Listing 9-16.

Listing 9-16. Using Callbacks to Interact with the Windows File Picker Dialog

'UDT to pass information to the SHBrowseForFolder function
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'Commonly used ulFlags constants
'Only return file system directories.
'If the user selects folders that are not
'part of the file system (such as 'My Computer'),
'the OK button is grayed.
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
'Use a newer dialog style, which gives a richer experience
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
'Hide the default 'Make New Folder' button
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200
'Messages sent from dialog to callback function
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
'Messages sent to browser from callback function
Private Const WM_USER = &H400
'Set the selected path
Private Const BFFM_SETSELECTIONA = WM_USER + 102
'Enable/disable the OK button
Private Const BFFM_ENABLEOK = WM_USER + 101
'The maximum allowed path
Private Const MAX_PATH = 260
'Main Browse for directory function
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(ByRef lpBrowseInfo As BROWSEINFO) As Long
'Gets a path from a pidl
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
'Used to set the browse dialog's title
Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
'A versions of SendMessage, to send strings to the browser
Private Declare Function SendMessageString Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As String) As Long
'Variables to hold the initial options,
'set in the callback function
Dim msInitialPath As String
Dim msTitleBarText As String
'The main function to initialize and show the dialog
Function GetDirectory(Optional ByVal sInitDir As String, _
Optional ByVal sTitle As String, _
Optional ByVal sMessage As String, _
Optional ByVal hwndOwner As Long, _
Optional ByVal bAllowCreateFolder As Boolean) _
As String
'A variable to hold the UDT
Dim uInfo As BROWSEINFO
Dim sPath As String
Dim lResult As Long
'Check that the initial directory exists
On Error Resume Next
sPath = Dir(sInitDir & "\*.*", vbNormal + vbDirectory)
If Len(sPath) = 0 Or Err.Number <> 0 Then sInitDir = "
On Error GoTo 0
'Store the initials setting in module-level variables,
'for use in the callback function
msInitialPath = sInitDir
msTitleBarText = sTitle
'If no owner window given, use the Excel window
'N.B. Uses the ApphWnd function in MWindows
If hwndOwner = 0 Then hwndOwner = ApphWnd
'Initialise the structure to pass to the API function
With uInfo
.hOwner = hwndOwner
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszTitle = sMessage
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE _
+ IIf(bAllowCreateFolder, 0, BIF_NONEWFOLDERBUTTON)
'Pass the address of the callback function in the UDT
.lpfn = LongToLong(AddressOf BrowseCallBack)
End With
'Display the dialog, returning the ID of the selection
lResult = SHBrowseForFolder(uInfo)
'Get the path string from the ID
GetDirectory = GetPathFromID(lResult)
End Function
'Windows calls this function when the dialog events occur
Private Function BrowseCallBack (ByVal hwnd As Long, _
ByVal Msg As Long, ByVal lParam As Long, _
ByVal pData As Long) As Long
Dim sPath As String
'This is called by Windows, so don't allow any errors!
On Error Resume Next
Select Case Msg
Case BFFM_INITIALIZED
'Dialog is being initialized,
'so set the initial parameters
'The dialog caption
If msTitleBarText <> " Then
SetWindowText hwnd, msTitleBarText
End If
'The initial path to display
If msInitialPath <> " Then
SendMessageString hwnd, BFFM_SETSELECTIONA, 1, _
msInitialPath
End If
Case BFFM_SELCHANGED
'User selected a folder
'lParam contains the pidl of the folder, which can be
'converted to the path using GetPathFromID
'sPath = GetPathFromID(lParam)
'We could put extra checks in here,
'e.g. to check if the folder contains any workbooks,
'and send the BFFM_ENABLEOK message to enable/disable
'the OK button:
'SendMessage hwnd, BFFM_ENABLEOK, 0, True/False
End Select
End Function
'Converts a PIDL to a path string
Private Function GetPathFromID(ByVal lID As Long) As String
Dim lResult As Long
Dim sPath As String * MAX_PATH
lResult = SHGetPathFromIDList(lID, sPath)
If lResult <> 0 Then
GetPathFromID = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
End If
End Function
'VBA doesn't let us assign the result of AddressOf
'to a variable, but does allow us to pass it to a function.
'This 'do nothing' function works around that problem
Private Function LongToLong(ByVal lAddr As Long) As Long
LongToLong = lAddr
End Function

Let's take a closer look at how this all works. First, most of the shell functions use things called PIDLs to uniquely identify folders and files. For simplicity's sake, you can think of a PIDL as a handle to a file or folder, and there are API functions to convert between the PIDL and the normal file or folder name.