Microsoft KB Archive/130557

= Creating a Linked Directory List Box =

Article ID: 130557

Article Last Modified on 10/11/2006

-

APPLIES TO


 * Microsoft Excel 97 Standard Edition
 * Microsoft Excel 95 Standard Edition
 * Microsoft Excel 5.0 Standard Edition

-



This article was previously published under Q130557



SUMMARY
In Microsoft Excel, to create a macro that allows a user to select a file to open, use the GetOpenFileName method in Visual Basic for Applications.

GetOpenFileName displays the same dialog box that Microsoft Excel displays when you choose the Open command from the File menu. The GetOpenFileName method allows you to set the initial settings for the Open dialog box, to set the dialog caption, and to manipulate the resulting selection in your Visual Basic Code.

In many situations, you may want to have your users select a directory only for a particular installation or for file storage. You may want to present your users with a dialog box from which they can select any directory on their system without being distracted by the file lists and filters of the GetOpenFileName dialog box. You can use the following Visual Basic sample code to create and operate such a dialog box.



MORE INFORMATION
The following code creates a dialog that is solely for the purpose of changing the active drive and/or directory. It displays a single list box populated with only directories. A filename cannot be added to the list box unless it has the attribute of being a directory.

To use this code:

 On a new Visual Basic module sheet, enter the dialog creator sub procedure. On another module sheet, enter the following sub procedures:

Master

InitializeTheList

Showit

GoToIt

Dismiss_Click

DrvSwitcher

 Run the "dialog_creator" once to create the dialog box, and then run the Master procedure to display the dialog box correctly.

Note that this is also an excellent example of the Dir function: it can easily be modified to support other file search names and attributes.

Microsoft provides examples of Visual Basic procedures for illustration only, without warranty either expressed or implied, including but not limited to the implied warranties of merchantability and/or fitness for a particular purpose. This Visual Basic procedure is provided 'as is' and Microsoft does not guarantee that it can be used in all situations. Microsoft does not support modifications of this procedure to suit customer requirements for a particular purpose. Note that a line that is preceded by an apostrophe introduces a comment in the code--comments are provided to explain what the code is doing at a particular point in the procedure. Note also that an underscore character (_) indicates that code continues from one line to the next. You can type lines that contain this character as one logical line or you can divide the lines of code and include the line- continuation character. For more information about Visual Basic for Applications programming style, see the "Programming Style in This Manual" section in the "Document Conventions" section of the "Visual Basic User's Guide."

Module 1:
'--- 'Run this code only once! Sub dialog_creator DialogSheets.Add ActiveSheet.Name = "Directory Switcher" Set DLG = DialogSheets("Directory Switcher") With DLG.DialogFrame .Left = 0 .Top = 0 .Caption = "Directory Switcher" .Height = 215 .Width = 202 End With

DLG.Labels.Add Top:=25, Left:=20, Width:=160, Height:=15 With DLG.Labels(1) .Name = "Path_String" .Caption = CurDir End With

DLG.Labels.Add Top:=21, Left:=199.5, Width:=160, Height:=33 With DLG.Labels(2) .Name = "instructions" .Caption = "Double click an entry to select it. " & _ "Select the "".."" to ascend one level" End With

DLG.Buttons.Add Left:=310, Top:=100, Width:=60, Height:=15 Set dfltbtn = DLG.Buttons(3) With dfltbtn .Caption = "Don't click!" .OnAction = "GoToIt" .DismissButton = False .DefaultButton = True End With

DLG.ListBoxes.Add Left:=20, Top:=45, Width:=160, Height:=100 Set lb = DLG.ListBoxes(1) lb.Name = "SwitcherLB"

DLG.Buttons.Add Left:=21, Top:=156.75, Width:=157.5, Height:=15.75 Set drvchgr = DLG.Buttons(4) drvchgr.Caption = "Change Drive" drvchgr.Name = "Drvchanger" drvchgr.OnAction = "DrvSwitcher"

Set OKbtn = DLG.DrawingObjects("Button 2") With OKbtn .Left = 21 .Top = 177.75 .Name = "OKButton" .OnAction = "Dismiss_Click" End With

Set Cnclbtn = DLG.DrawingObjects("Button 3") With Cnclbtn .Left = 126 .Top = 177.75 .Name = "CancelButton" .OnAction = "Dismiss_Click" End With

End Sub

Module 2:
'--- Option Explicit

Dim KeepShowing As Boolean Dim StartDirect As String Dim DirList As String Dim ChoiceDir As String Dim DLG As DialogSheet Public drv As String * 1

'This procedure runs the others and is the proper way to launch the code Sub Master KeepShowing = True StartDirect = CurDir ChoiceDir = StartDirect InitializeTheList Showit End Sub

Sub InitializeTheList 'dimension the object variable for the dialog Set DLG = DialogSheets("Directory Switcher") 'make the label show where you are now DLG.Labels("Path_String").Text = CurDir 'clear out the list box on the dialog DLG.ListBoxes("SwitcherLB").RemoveAllItems 'if the chosen directory is the root directory If Len(ChoiceDir) = 3 Then 'this returns only directories to the list DirList = Dir(ChoiceDir & "*", vbDirectory) ' Else 'append a "\" to the list and then get the directories there DirList = Dir(ChoiceDir & "\*", vbDirectory) ' End If  'Use a loop to recall the dir function as long as there are 'directories at this level. Do While Len(DirList) > 0 Select Case DirList Case Is = "." 'doing nothing jumps the code to the end select Case Is = ".." 'doing nothing jumps the code to the end select Case Else Dim analysis as Integer 'bitwise comparison analyzes if the file is a directory analysis = GetAttr(DirList) And vbDirectory 'if it IS a directory, If analysis > 0 Then 'jump to the endif statement below Else 'otherwise force the code to the end of the loop GoTo endlooper End If     End Select 'add dirlist to the list DLG.ListBoxes("SwitcherLB").AddItem DirList endlooper: 'look for the next file DirList = Dir 'return to the top of the do loop Loop End Sub

Sub Showit 'show the dialog within a loop which repeats until the KeepShowing 'variable is set to false (see the Dismiss_Click procedure) Do While KeepShowing = True 'if the user clicked OK then If DLG.Show = True Then 'do nothing special Else 'If the user clicked cancel, return the current directory 'to the one that was there before starting this procedure. ChDir (StartDirect) End If    'return to the top of the loop Loop End Sub

Sub GoToIt 'This is called by the default button (labeled "Don't click") which 'is not shown within the dialog frame. Dim childtofind as string 'childtofind holds the value of which choice was made from the list childtofind = DLG.ListBoxes(1). _     List(DLG.ListBoxes(1).ListIndex) 'if the current directory is the root If Len(CurDir) > 3 Then 'append a "\" character to it before changing directories ChDir (CurDir & "\" & childtofind) Else 'just concatenate the choice made with the current directory 'and switch to it     ChDir (CurDir & childtofind) End If  'refresh the value of the choicedir variable for evaluation in the _ 'initializing procedure ChoiceDir = CurDir InitializeTheList End Sub

Sub Dismiss_Click 'this is called by the OK and cancel buttons KeepShowing = False End Sub

Sub DrvSwitcher 'enable an escape route Application.EnableCancelKey = xlInterrupt 'error handler On Error GoTo oops 'assign value to drv drv = Left(InputBox(prompt:="Enter a valid drive letter:", _ default:=Left(CurDir, 1), _ Title:="Choose another drive"), 1) 'Check to see if Cancel was pressed If Trim(drv) = "" Then Exit Sub 'change drive to drv. If an error occurs, it will be here ChDrive drv 'update the choicedir variable for evaluation during the 'initialize the list routine ChoiceDir = CurDir 'this added to debug problem drive switching InitializeTheList 'if no errors encountered, relinquish control to the calling _ procedure Exit Sub 'In case the drive letter you entered is invalid, this will handle 'the error oops: MsgBox "The drive you have entered is invalid." & Chr(13) & _ "Please enter a valid drive." 'A second chance drv = Left(InputBox(prompt:="Enter a valid drive letter:", _ default:=Left(CurDir, 1), _ Title:="Choose another drive"), 1) 'return to the line after where the error occurred (most likely  'the line above where choicedir is reassigned its value before   'calling initialize the list) Resume Next End Sub

