VBA for folder naviagation

[James]

I have this code that breaks out the worksheets in a workbook into their own
seperate files and it works great with one exception. Right now we have to
copy and paste the location to where we want to save the files in a message
box. What I would like to do is to be able to navigate to where I want to
save these files too.

What I would like to change it the "Get output directory". I would like the
end user to be able to navigate excatly to where they want to save their
files to.

Below is what the code looks like:
Sub Create_CSV_from_Worksheets()
' -----------------------------------------------------------------------
' -----------------------------------------------------------------------
' Get output directory

Dim strDir As String
strDir = InputBox("This macro will save each worksheet in the workbook
as a sperate CSV file for import into iPoint." _
+ Chr(13) + Chr(13) + "Please enter the directory path for where the
files should be saved. The folder has to exist already." _
+ Chr(13) + Chr(13) + "Example: \\hotce15\t\username\folder\",
"Directory", "\\Directory\")

If strDir = "" Then If MsgBox("Invalid entry. Exiting macro operation.",
vbOKOnly, "Error") = vbOK Then Exit Sub
If strDir = "\\Directory\" Then If MsgBox("Invalid entry. Exiting macro
operation.", vbOKOnly, "Error") = vbOK Then Exit Sub
' -----------------------------------------------------------------------
' -----------------------------------------------------------------------
'
' ------------------------------------------------------------------------
' ------------------------------------------------------------------------
' Message Box asking if you wish to continue

If MsgBox("Is this the full directory where the CSV files will be
saved?" _
+ Chr(13) + Chr(13) + strDir, _
Chr(13) + Chr(13) + "Note: Depending on the number of wells this process
could take a couple minutes.", _
vbYesNo, "Macro: Create_CSV_from_Worksheets") = vbNo Then Exit Sub
' ------------------------------------------------------------------------
' ------------------------------------------------------------------------
'
' ------------------------------------------------------------------------
' ------------------------------------------------------------------------
' Save files as CSV

Dim s As Worksheet
For Each s In Sheets
s.Activate
t = s.Name
ActiveWorkbook.SaveAs Filename:=strDir & t, _
FileFormat:=xlCSV, CreateBackup:=False
Next

If MsgBox("The process has completed.", vbOKOnly, "Complete") = vbOK
Then Exit Sub
'

 

[Steve Yandl]

James,

Below are two subroutines that exhibit different options for allowing the
user to navigate to a folder to retrieve the folder path. In both cases you
can modify start folder and other parameters.

'-------------------------------------
Sub GetFolderB()
Dim fd As FileDialog
Dim strPath As String
Dim selFldr As Variant

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

If fd.Show = -1 Then
selFldr = fd.SelectedItems(1)
strPath = selFldr & "\"
End If

MsgBox strPath

Set fd = Nothing
End Sub
'-------------------------------------

'-------------------------------------
Sub GetFolderA()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Select Folder", 0)
If objFolder Is Nothing Then
Exit Sub
Else
strPath = objFolder.Self.Path
End If
MsgBox strPath
Set objFolder = Nothing
Set objShell = Nothing
End Sub
'-------------------------------------

Steve Yandl

 

[James]

Steve,
This worked great thank you for the code.