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
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
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
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.
The GetDirectory function is the main function in the module and is the function that should be called to display the dialog. It starts by validating the (optional) input parameters, then populates the BROWSEINFO user-defined type that is used to pass all the required information to the SHBrowseForFolder function. The hOwner element of the UDT is used to provide the parent window for the dialog, which should be the handle of the main Excel window, or the handle of the userform window if showing this dialog from a userform. The ulFlags element is used to specify detailed behavior for the dialog, such as whether to show a Make Folder button. The full list of possible flags and their purpose can be found on MSDN by searching for the SHBrowseForFolder function. The lpfn element is where we pass the address of the callback function, BrowseCallBack. We have to wrap the AddressOf value in a simple LongToLong function, because VB doesn't let us assign the value directly to an element of a UDT.
After the UDT has been initialized, we pass it to the SHBrowseForFolder API function. That function displays the dialog and Windows calls back to our BrowseCallBack function, passing the BFFM_INITIALIZED message. We respond to that message by setting the dialog's caption (using the SetWindowText API function) and the initial folder selection (by sending the BFFM_SETSELECTIONA message back to the dialog with the path string).
Every time the user clicks a folder, it triggers a Windows callback to our BrowseCallBack function, passing the BFFM_SELCHANGED message and the ID of the selected folder. All the code to respond to that message is commented out in this example, but we could add code to check whether the folder is a valid selection for our application (such as whether it contains any workbooks) and enable/disable the OK button appropriately (by sending the BFFM_ENABLEOK message back to the dialog).
When the user clicks the OK or Cancel button, the function returns the ID of the selected folder and execution continues back in the GetDirectory function. We get the textual path from the returned ID and return it to the calling code.