VERSION 5.00
Begin VB.Form frmDirPath
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   4935
   ClientLeft      =   5010
   ClientTop       =   2475
   ClientWidth     =   3015
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4935
   ScaleWidth      =   3015
   ShowInTaskbar   =   0   'False
   Visible         =   0   'False
   Begin VB.CommandButton cmdNewFolder
      Caption         =   "New Folder"
      Default         =   -1  'True
      Height          =   390
      Left            =   75
      TabIndex        =   3
      Top             =   4500
      Width           =   1440
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   390
      Left            =   1500
      TabIndex        =   2
      Top             =   4500
      Width           =   1440
   End
   Begin VB.DirListBox Dir1
      Height          =   3690
      Left            =   75
      TabIndex        =   1
      Top             =   750
      Width           =   2865
   End
   Begin VB.DriveListBox Drive1
      Height          =   315
      Left            =   75
      TabIndex        =   0
      Top             =   375
      Width           =   2865
   End
   Begin VB.Label Label1
      Alignment       =   2  'Center
      Caption         =   "Get Path"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   240
      Left            =   75
      TabIndex        =   4
      Top             =   0
      Width           =   2865
   End
End
Attribute VB_Name = "frmDirPath"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
 Dim mPath As String 'holds the current path


' The OK button was chosen so make the form invisible, do not close it as you need to get the
' path from the MyPath property.  Check the mPath to see if it holds two "\". If it has than the
' root directory was chosen and the program added an extra "\" to it.
Private Sub cmdOK_Click()
    Me.Visible = False
    If Right$(mPath, 2) = "\\" Then mPath = Left$(mPath, Len(mPath) - 1)
End Sub

' This button creates a new folder using the MkDir function of VB. It first askes the name of the
' new folder using the InputBox function. If no name is given it then the sub is exited otherwise
' the newfolder is set the the Dir1.Path and the name of the new folder. It is then created and the
' new path is set to the new folder.
Private Sub cmdNewFolder_Click()
    Dim NewFolder As String
    NewFolder = InputBox("New Folder Name")
    If NewFolder = "" Then Exit Sub
    NewFolder = Dir1.Path & "\" & NewFolder
    MkDir NewFolder
    Dir1.Path = NewFolder
End Sub

' When the directory is changed then set mPath to the directory.
Private Sub Dir1_Change()
    mPath = Dir1.List(Dir1.ListIndex) & "\"
End Sub

' When a directory is clicked on then set mPath to this directory.
Private Sub Dir1_Click()
    mPath = Dir1.List(Dir1.ListIndex) & "\"
End Sub

' When the dirve is changed set the path to the new dirve
Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

' Returns the path you choose
Public Property Get MyPath() As String
    MyPath = mPath
End Property

' Sets the path of your choice. Extracts the dirve letter and the path.
Public Property Let MyPath(ByVal vNewValue As String)
    mPath = vNewValue
    Drive1.Drive = Left(mPath, InStr(mPath, ":") - 1)
    Dir1.Path = mPath
End Property

' Center the form on the screen
Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
End Sub