Printable View
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?
[VBA]If Not Application.Dialogs(xlDialogSaveAs).Show(, 1) Then
MsgBox "The Report did not Save."
End If[/VBA]
Check out Cdrive and ChDir
ok I will look at them
Wouldn't that be ChDrive, Bob? :)
Daniel, I have an example of a UDF to Get File Name From Specific Directory. It will help in understanding the use of ChDrive and ChDir.
HTH,
Ken, Bob:
I am using this code:
[vba]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[/vba]
However, the save as dialog isn't starting in that directory for some reason?
I even tested this code:
[VBA]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[/VBA]
this opens the save as dialog for me in F:\Temp
[VBA]Sub a()
ChDir "f:\Temp"
If Not Application.Dialogs(xlDialogSaveAs).Show(, 1) Then
End If
End Sub[/VBA]
Does it matter if the drive is a network drive?
I'm guessing that you would have to map the network drive in windows explorer first but I'm not a network type.....
Thanks for trying lucas. Does anyone else know why it won't work with my network drive?
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:
[vba]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)
'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)
'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[/vba]
ok, i looked at that code. I just didn't understand it, I guess I will have to look at it harder. thank you.
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.
[VBA]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)
'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[/VBA]
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...
[vba]sDirDefault = "H:\\Dblois"[/vba]
try removing one of them..
I originally tried with only one \ but looking at Ken's code, I thought maybe Network drives needed 2 \\:
[VBA]If Not Left(sDirDefault, 2) = "\\" Then
'Not a network drive, so use ChDir
[/VBA]
Now I am testing this:
[vba]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[/vba]
It still won't work? Ken since it is your code maybe you know what I am doing wrong?
Hi there,
So big question... how does the drive display in windows explorer? Is it H:\dblois, or is it \\servername\dblois?
Here you go Ken, copied right out of Explorer:
H:\dblois
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?
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.
Daniel do you have your network mapped? Does it show in windows explorer as my Z:\Temp drive shows in the screen shot below?
Hmm... I'd forgotten about this.
It looks as if you'll have to find a workaround, Daniel. There is a couple suggested in the thread I linked to.
HTH,
Wow,
Ken I am going to cry. lol I have tried every suggestion in there and nothing works. lol Thank you for the help
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,
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.
Where did you ask.....from an example I yoinked from Ken
Really? Interesting...Quote:
Originally Posted by Djblois
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):
[vba]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[/vba]
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?
but Ken can people go into subdirectories in a userform also?
double click the directories in the form...
Yes...Quote:
Originally Posted by Djblois
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.
Yes Ken and Steve but that is a function? how do I put a function in a listbox? sorry for my ignorance?
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.Quote:
Originally Posted by Djblois
Truthfully, Steve's may be a better fit for you than mine.
You can call Kens function starting in a specific directory and return it to a textbox like this:
[VBA]Private Sub CommandButton1_Click()
TextBox1.Value = GetFolderName("Z:\Temp")
End Sub[/VBA]
This actually works in an easier way:
[VBA]Sub ComSaveCode()
Dim wbSaveName
ChDrive "H:"
ChDir "H:\dblois"
wbSaveName = Application.GetSaveAsFilename
wbSaveName.Save FileName:=wbSaveName
End Sub[/VBA]
only problem I want it to automatically save as an excel file. Is this possible?
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?
1. example:
[VBA]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
[/VBA]
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.
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:
[VBA]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[/VBA]
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.
[VBA]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[/VBA]
I'm not sure but do you look for something like this :
http://vbaexpress.com/forum/showpost...3&postcount=18