PDA

View Full Version : Solved: Allow users to set default save directory.



Djblois
04-27-2007, 09:57 AM
I want to create a text box where my users can save a default save directory. and when the save as dialog comes up within my program it opens up in that dialog. is this possible?

I already know how to save it to a registry setting but how do I open the save as dialog into that folder?

If Not Application.Dialogs(xlDialogSaveAs).Show(, 1) Then
MsgBox "The Report did not Save."
End If

Bob Phillips
04-27-2007, 11:21 AM
Check out Cdrive and ChDir

Djblois
04-27-2007, 11:33 AM
ok I will look at them

Ken Puls
04-27-2007, 03:19 PM
Wouldn't that be ChDrive, Bob? :)

Daniel, I have an example of a UDF to Get File Name From Specific Directory (http://www.excelguru.ca/node/48). It will help in understanding the use of ChDrive and ChDir.

HTH,

Djblois
04-30-2007, 07:22 AM
Ken, Bob:

I am using this code:

ChDrive "H:"
ChDir "H:\dblois\My Documents\Current Projects"

If Not Application.Dialogs(xlDialogSaveAs).Show(, 1) Then
MsgBox "The Report did not Save."
End If

However, the save as dialog isn't starting in that directory for some reason?

Djblois
04-30-2007, 08:51 AM
I even tested this code:

Dim DefaultDrive As String
Dim DefaultDir As String

DefaultDrive = "H"
DefaultDir = "H:\dblois\My Documents\Current Projects"

ChDrive (DefaultDrive)
ChDir (DefaultDir)

If Not Application.Dialogs(xlDialogSaveAs).Show(, 1) Then
MsgBox "The Report did not Save."
End If

lucas
04-30-2007, 10:30 AM
this opens the save as dialog for me in F:\Temp
Sub a()
ChDir "f:\Temp"
If Not Application.Dialogs(xlDialogSaveAs).Show(, 1) Then
End If
End Sub

Djblois
04-30-2007, 10:35 AM
Does it matter if the drive is a network drive?

lucas
04-30-2007, 10:39 AM
I'm guessing that you would have to map the network drive in windows explorer first but I'm not a network type.....

Djblois
04-30-2007, 10:41 AM
Thanks for trying lucas. Does anyone else know why it won't work with my network drive?

lucas
04-30-2007, 11:12 AM
Daniel....
Ken's code from the link above works for networks if you change the path in the function..
ps I didn't change it from file open to saveas as I was trying to get it to find the network drive for you:
Option Explicit
Private Declare Function SetCurrentDirectoryA _
Lib "kernel32" (ByVal lpPathName As String) As Long
Public Function GetOpenFilenameFrom(Optional sDirDefault As String) As Variant
'Author : Ken Puls (www.excelguru.ca (http://www.excelguru.ca))
'Macro Purpose: To ask for a file at a specified directory
Dim sDirCurrent As String
Dim lError As Long
'Make note of the current directory
sDirCurrent = "Z:\Temp"
If sDirDefault = vbNullString Then
'If optional arguement not supplied then
'assign current directory as default
sDirDefault = "Z:\Temp"
Else
'If option arguement is supplied, test path to ensure
'that it exists. If not, assign current directory
If Len(Dir(sDirDefault, vbDirectory)) = 0 Then
sDirDefault = sDirCurrent
End If
End If
'Change the drive and directory
'*Drive change is unecessary if same, but takes as long to test
' as just changing it
If Not Left(sDirDefault, 2) = "\\" Then
'Not a network drive, so use ChDir
ChDrive Left(sDirDefault, 1)
ChDir (sDirDefault)
Else
'Network drive, so use API
lError = SetCurrentDirectoryA(sDirDefault)
If lError = 0 Then _
MsgBox "Sorry, I encountered an error accessing the network file path"
ChDir (sDirDefault)
End If
'Get the file's name & path, setting the filters to only display
'desired types. Help on the exact syntax can be found by looking
'up the GetOpenFilename method in the VBA help files
GetOpenFilenameFrom = Application.GetOpenFilename _
("Excel Files (*.xl*), *.xl*,All Files (*.*),*.*")
'Change the drive and directory back
If Not Left(sDirCurrent, 2) = "\\" Then
'Not a network drive, so use ChDrive
ChDrive Left(sDirCurrent, 1)
ChDir (sDirCurrent)
Else
'Network drive, so use API
lError = SetCurrentDirectoryA(sDirCurrent)
If lError = 0 Then _
MsgBox "Sorry, I encountered an error resetting the network file path"
ChDir (sDirCurrent)
End If
End Function
Sub GetMeAFile()
'Author : Ken Puls (www.excelguru.ca (http://www.excelguru.ca))
'Macro Purpose: To test the GetOpenFilenameFrom function
Dim sWBToOpen As Variant
sWBToOpen = GetOpenFilenameFrom(Range("A3").Value)

If Not sWBToOpen = False Then Workbooks.Open (sWBToOpen)

End Sub

Djblois
04-30-2007, 11:16 AM
ok, i looked at that code. I just didn't understand it, I guess I will have to look at it harder. thank you.

Djblois
04-30-2007, 01:41 PM
Ken, Lucas:

this is what I got the code up to and logically it looks like it should work but it doesn't. I guess I don't know enough about VBA yet.

Option Explicit
Private Declare Function SetCurrentDirectoryA _
Lib "kernel32" (ByVal lpPathName As String) As Long
Public Function GetSaveFileDir(Optional sDirDefault As String) As Variant
'Author : Ken Puls (www.excelguru.ca (http://www.excelguru.ca))
'Macro Purpose: To ask for a file at a specified directory
Dim sDirCurrent As String
Dim lError As Long
'Make note of the current directory
sDirCurrent = "H:\\Dblois"
If sDirDefault = vbNullString Then
'If optional arguement not supplied then
'assign current directory as default
sDirDefault = "H:\\Dblois"
Else
'If option arguement is supplied, test path to ensure
'that it exists. If not, assign current directory
If Len(Dir(sDirDefault, vbDirectory)) = 0 Then
sDirDefault = sDirCurrent
End If
End If
'Change the drive and directory
'*Drive change is unecessary if same, but takes as long to test
' as just changing it
If Not Left(sDirDefault, 2) = "\\" Then
'Not a network drive, so use ChDir
ChDrive Left(sDirDefault, 1)
ChDir (sDirDefault)
Else
'Network drive, so use API
lError = SetCurrentDirectoryA(sDirDefault)
If lError = 0 Then _
MsgBox "Sorry, I encountered an error accessing the network file path"
ChDir (sDirDefault)
End If

End Function
Sub testcode()

Dim sDirToSaveTo As Variant
sDirToSaveTo = GetSaveFileDir
If Not sDirToSaveTo = False Then ChDir (sDirToSaveTo)
If Not Application.Dialogs(xlDialogSaveAs).Show(, 1) Then
MsgBox "The Report did not Save."
End If

End Sub

lucas
04-30-2007, 07:01 PM
I'm not sure either Daniel because it does work for me....only thing I can see would be a path problem....are you sure of it?

ahh, I just noticed something...in the function you have 2 backslashes in your path...
sDirDefault = "H:\\Dblois"
try removing one of them..

Djblois
04-30-2007, 07:24 PM
I originally tried with only one \ but looking at Ken's code, I thought maybe Network drives needed 2 \\:

If Not Left(sDirDefault, 2) = "\\" Then
'Not a network drive, so use ChDir

Djblois
05-01-2007, 05:20 AM
Now I am testing this:

Sub testcode()

Dim sDirToSaveTo As Variant
Dim sDirCurrent As String
Dim lError As Long
'Make note of the current directory
sDirCurrent = "H:\Dblois"
If sDirDefault = vbNullString Then
'If optional arguement not supplied then
'assign current directory as default
sDirDefault = "H:\Dblois"
Else
'If option arguement is supplied, test path to ensure
'that it exists. If not, assign current directory
If Len(Dir(sDirDefault, vbDirectory)) = 0 Then
sDirDefault = sDirCurrent
End If
End If
'Change the drive and directory
'*Drive change is unecessary if same, but takes as long to test
' as just changing it
If Not Mid(sDirDefault, 3, 2) = "\\" Then
'Not a network drive, so use ChDir
ChDrive Left(sDirDefault, 1)
ChDir (sDirDefault)
Else
'Network drive, so use API
'lError = SetCurrentDirectoryA(sDirDefault)
If lError = 0 Then _
MsgBox "Sorry, I encountered an error accessing the network file path"
ChDir (sDirDefault)
End If
sDirToSaveTo = sDirDefault
If Not sDirToSaveTo = False Then ChDir (sDirDefault)
If Not Application.Dialogs(xlDialogSaveAs).Show(, 1) Then
MsgBox "The Report did not Save."
End If

It still won't work? Ken since it is your code maybe you know what I am doing wrong?

Ken Puls
05-01-2007, 09:15 AM
Hi there,

So big question... how does the drive display in windows explorer? Is it H:\dblois, or is it \\servername\dblois?

Djblois
05-01-2007, 09:19 AM
Here you go Ken, copied right out of Explorer:

H:\dblois

Ken Puls
05-01-2007, 09:33 AM
I just copied your most recent code, and tried testing with both of the following directories which are valid on my system:
J:\vba tests
C:\tmp

Both launched just fine.

What errors are you getting, if any? Does it stop on a line when you try to step through? Are you watching the values being set in the locals window to ensure that they are correct?

Djblois
05-01-2007, 10:35 AM
I have watched them in the watch window and I am not getting any errors. It is just running through and opening into the save as dialog but not in my directory.

lucas
05-01-2007, 10:44 AM
Daniel do you have your network mapped? Does it show in windows explorer as my Z:\Temp drive shows in the screen shot below?

Ken Puls
05-01-2007, 11:05 AM
Hmm... I'd forgotten about this (http://www.vbaexpress.com/forum/showthread.php?t=1664&highlight=saveas).

It looks as if you'll have to find a workaround, Daniel. There is a couple suggested in the thread I linked to.

HTH,

Djblois
05-01-2007, 11:50 AM
Wow,

Ken I am going to cry. lol I have tried every suggestion in there and nothing works. lol Thank you for the help

Ken Puls
05-01-2007, 02:59 PM
Yep, that's kind of the point. It won't.

I suppose that you could either a) roll your own dialog, or b) live with it.

Cheers,

Djblois
05-02-2007, 08:34 AM
Ken,

When you say roll my own dialog? do you mean create my own userform? because I have asked if it is possible to create a userform where a user can navigate to a folder and I was told I can't.

lucas
05-02-2007, 08:56 AM
Where did you ask.....from an example I yoinked from Ken

Ken Puls
05-02-2007, 09:16 AM
I have asked if it is possible to create a userform where a user can navigate to a folder and I was told I can't.

Really? Interesting...

It may not be as seemeless as the built in dialogs, but sure you could do it. Set up two text boxes on a userform. The first one would hold your directory, and would be populated with a routine like the one below (Excel 2002+ search KB for BrowseForFolder for 97-2000 compliant version):
Private Function GetFolderName(Optional OpenAt As String) As String
'Macro Purpose: To retrieve a file name from a specific location

Dim lngcount

'Ensure that file path ends in a slash
If Len(OpenAt) > 0 Then If Right(OpenAt, 1) <> "\" Then OpenAt = OpenAt & "\"

'Prompt the user for a filename
With Application.FileDialog(4) '4=msoFileDialogFolderPicker
.InitialFileName = OpenAt
.Show
For lngcount = 1 To .SelectedItems.Count
GetFolderName = .SelectedItems(lngcount)
Next lngcount
End With
End Function
The second text box, you'd just type in the file name that you want to save under.

Add an okay button, validate that the path exists, and save the file. If you really feel clever, save the chosen path in the registry so that you can feed it back in as a default the next time someone wants to save a file using via your userform.

EDIT: Steve, that was yoinked from me? It doesn't look familiar... inspired, maybe, but yoinked?

Djblois
05-02-2007, 10:45 AM
but Ken can people go into subdirectories in a userform also?

lucas
05-02-2007, 10:47 AM
double click the directories in the form...

Ken Puls
05-02-2007, 10:53 AM
but Ken can people go into subdirectories in a userform also?

Yes...

Steve has given you the steps for his. My suggestion is less elegant, but essentially launches the folder picker dialog so that you can pick the folder you want. It will drill up or down.

Djblois
05-02-2007, 11:06 AM
Yes Ken and Steve but that is a function? how do I put a function in a listbox? sorry for my ignorance?

Ken Puls
05-02-2007, 11:27 AM
Yes Ken and Steve but that is a function? how do I put a function in a listbox?

You don't. It won't work that way. You'd attach it to a commandbutton, and it feed the value back into a text box.

Truthfully, Steve's may be a better fit for you than mine.

lucas
05-02-2007, 11:34 AM
You can call Kens function starting in a specific directory and return it to a textbox like this:
Private Sub CommandButton1_Click()
TextBox1.Value = GetFolderName("Z:\Temp")
End Sub

Djblois
05-11-2007, 10:40 AM
This actually works in an easier way:

Sub ComSaveCode()
Dim wbSaveName

ChDrive "H:"
ChDir "H:\dblois"
wbSaveName = Application.GetSaveAsFilename

wbSaveName.Save FileName:=wbSaveName

End Sub

only problem I want it to automatically save as an excel file. Is this possible?

Djblois
05-11-2007, 11:01 AM
I thought it was closer than it is.

1) first how do I tell it to save in the folder that the user chose
2) when the GetSaveAsFileName dialog shows up the name is always enclosed in "" how do I get rid of that?
3) Also how do I tell it to save as that name?

lucas
05-11-2007, 11:24 AM
1. example:
Dim newFile As String, fName As String
' Don't use "/" in date, invalid syntax
newFile = Format$(Date, "m-d-yy")
' Change directory to suit
ChDir _
"C:\Temp"
ActiveWorkbook.SaveAs Filename:=newFile

2. don't understand the question
3.....? what name?

been a while since I visited this thread so I'm not sure where you are with things....clarify please.

Djblois
05-11-2007, 11:28 AM
Please don't yell but for anyone who was also having trouble with this Here is the code. and from the other posting I figured this has been trouble. This is working for me:

ChDrive "H:"
ChDir "H:\dblois"

wbfilename = Application.GetSaveAsFilename

On Error Resume Next
If wbfilename = False Then
MsgBox "The File wasn't saved."
Exit Sub
End If
ActiveWorkbook.SaveAs wbfilename

The whole thing works but the last part is driving me crazy. I want it to show the msgbox if the user hits cancel or if the user leaves the name field blank. Right now it shows the msgbox all the time.

lucas
05-11-2007, 12:40 PM
Sub a()
Dim wbfilename As String
ChDrive "F:"
ChDir "F:\Temp\Daniel"

wbfilename = Application.GetSaveAsFilename
If wbfilename = "False" Then MsgBox "Test"
ThisWorkbook.SaveCopyAs Filename:=wbfilename & ".xls"
End Sub

Charlize
05-11-2007, 03:26 PM
I'm not sure but do you look for something like this :

http://vbaexpress.com/forum/showpost.php?p=99103&postcount=18