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
'

 

[James]

Steve,
This worked great thank you for the code.