Creating a Linked Directory List 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:

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

   Master
   InitializeTheList
   Showit
   GoToIt
   Dismiss_Click
   DrvSwitcher

3. 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."

Visual Basic Code Examples

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