Is there a Dialog or simple Userform to allow a user to choose a directory (not a file!)?


Posted by Boaz Kogon on May 18, 2000 5:12 AM

I'm trying to write some macros to automate some reporting. The macros need to import data from files all of which are stored in a common folder(like "f:\data\May 2000"), but I need to let the user choose the folder from a dialog.
In other words, I need a dialog like the FileOpen dialog, which displays the directory structure and allows the user to navigate the harddisk and select a folder.

If the only way is with a userform, how do I populate a listbox with the directory structure and let the user navigate up and down?

Thanks!!

Posted by Ivan Moala on May 18, 2000 3:52 PM

Hi Boaz
Here is a routine I made up for someone to
load All CSV files in a User selected Dir
format then close & save.
You can adapt it to your own needs.
Note the API function calls is what you need
to get the Browser operarting.

If you need assistance in changin a few things
then please leave msg.

Ivan

Option Explicit

Public Type BROWSEINFO
hOwner As Long
pid1Root As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'32bit API declarations
Declare Function SHGetPathFromIdList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pid1 As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional msg) As String
'===================================================================
'= Procedure: GetDirectory =
'= Type: Function =
'= =
'= Purpose: Gets browser for Dir input. Browse for folder =
'= This routine from =
'= J Walkenback =
'= Parameters: Optional msg - Variant - =
'= Returns: String - =
'= =
'= Version: Date: Developer: Action: =
'=---------|---------|---------------|-----------------------------=
'= 1.0.0 |11-May-00| Ivan Moala | Created =
'===================================================================
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

'Root folder = desktop
bInfo.pid1Root = 0&

'Title in the dialog
If IsMissing(msg) Then
bInfo.lpszTitle = "Select a folder"
Else
bInfo.lpszTitle = msg
End If

'Type of Dir to return
bInfo.ulFlags = &H1

'Display the dialog
x = SHBrowseForFolder(bInfo)

'Parse the result
path = Space$(512)
r = SHGetPathFromIdList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function


Sub Load_CSV()
'===================================================================
'= Procedure: Load_CSV =
'= Type: Subprocedure =
'= =
'= Purpose: Convert and auto format CSV file to Xls file =
'= format. Done for Nicolas Sirot =
'= Parameters: None =
'= Returns: Nothing =
'= =
'= Version: Date: Developer: Action: =
'=---------|---------|---------------|-----------------------------=
'= 1.0.1 |10-May-00| Ivan Moala | Created =
'===================================================================
Dim i As Integer
Dim Drive As String
Dim Ans As Integer
Dim Filename 'Must be a variant !!
Dim ChFiles() As String
Dim FFiles As Integer
Dim WB As Integer
Dim test As String
Dim Q As Integer
Dim OldSB As Boolean
Dim NewSB

SelectAgain:
'---------------------
Drive = GetDirectory("Select the directory of the files to change the format for:")
If Drive = "" Then End
Ans = MsgBox(Drive, vbInformation + vbYesNo, "Load all CSV files in this Directory?")
If Ans = vbNo Then GoTo SelectAgain
'----------------------

With Application.FileSearch
.NewSearch
.LookIn = Drive
.SearchSubFolders = False
.Filename = "*.CSV"
.MatchTextExactly = True
.MatchAllWordForms = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
ReDim ChFiles(.FoundFiles.Count)
For i = 1 To .FoundFiles.Count
ChFiles(i) = .FoundFiles(i)
Next
End If
If .FoundFiles.Count = 0 Then
Q = MsgBox("No CSV files in " & Drive & Chr(13) & Chr(13) & _
"Select another Dir?", vbExclamation + vbYesNo, "Search Result")
If Q = vbYes Then GoTo SelectAgain
End
End If
End With
'---------------------------------------------------------------------
On Error GoTo ErrH

'Turn off Screenupdatin to speed things up
Application.ScreenUpdating = False

'Setup Statusbar to inform user
OldSB = Application.DisplayStatusBar
Application.DisplayStatusBar = True

'Now process array
For WB = 1 To UBound(ChFiles())

Workbooks.Open ChFiles(WB)
Application.StatusBar = "Formating:=" & ChFiles(WB) & ":Count=" & WB
'Now format sheet as per your QUESTION
With ActiveSheet.Cells
.Columns.AutoFit
End With
ActiveWorkbook.SaveAs Filename:=Left(ChFiles(WB), Len(ChFiles(WB)) - 3) & _
"xls", FileFormat:=xlNormal
ActiveWorkbook.Close

Next
Application.ScreenUpdating = True

MsgBox "Completed updating CSV files to: " & Drive & _
Chr(13) & Chr(13) & WB - 1 & " Files formated & Saved as an .xls file.", vbInformation
Application.DisplayStatusBar = OldSB
Application.StatusBar = False

Exit Sub

ErrH:
MsgBox Err.Number & " :=" & Err.Description

End Sub




Posted by Boaz on May 21, 2000 5:09 AM

Thanks Ivan,

As it happens I want to load all CSV files in the chosen directory and combine into a single report, so your function is perfect.

The one change I don't know how to make is that I would like the root directory to be a network drive (in this case Q:\ ) rather than the desktop.

I believe the following line is what needs to be modified but I'm not sure of the syntax:

'Root folder = desktop
bInfo.pid1Root = 0&

Many, many thanks!

Boaz