Dialogs SaveAs with different directory

[Thomas Stroebel]

Hello,

I need help for the following problem.

An already existing file will be changed by my macro and at the end I
want the user to save the file with a different name in a different
directory with the option to change the filename or directory. Therefore
I use the excel-standard-dialog "save as". But I want the dialog to
start in another path as the path the original-file is stored in. But
also I use the ChDrive and ChDir Parameters the dialog even starts in
the original-file-path. I think this is standard for the dialog and I
should maybe use a parameter in the show-arguement? The code is below.

Is there anybody to help me?

Thanks in advance
Thomas



Option Explicit
Sub SaveMyFile()
Dim xFileName, xAnswer

ChDrive "J"
ChDir "J:\myfolder"

xFileName = "testme.xls"
xAnswer = Application.Dialogs(xlDialogSaveAs).Show(xFileName)
End Sub

 

[Helmut Weber]

Hi Thomas,

probably same problems in all office applications.

An admittedly quirk workaraound:

Sub SaveMyFile()
Dim oDlg As Dialog
Set oDlg = Application.Dialogs(xlDialogSaveAs)
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "c:\test\test.xls"
oDlg.Show
End Sub

Leaves you with an unwanted copy of the file, but who cares?

Greetings from Bavaria, Germany

Helmut Weber

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Don Lloyd]

Hi Thomas,

Below is a copy of a routine that I use to prompt users to save as

The part that may interest you is the Suggest variable - make this whatever
you want, e.g. "C;\Myfolder\" adding subfolders if required (end with a \).

Also included is a check to see if the file exists - remove if not needed -
from Set Fs = . . . . down to End If.

Sub BtnSaveAs()
Dim Suggest, res, Fname, Hdr, Fs
Application.DisplayAlerts = False
Suggest = ThisWorkbook.Path & "\"
Hdr = "Please choose a Destination for the Copy, give it a name then click
Save."
GetFname:
Fname = Application.GetSaveAsFilename(Suggest, fileFilter:="Excel File
(*.xls), *.xls)", Title:=Hdr)
If Not Fname = False Then
Set Fs = CreateObject("Scripting.FileSystemObject")
If Fs.FileExists(Fname) Or Fs.FileExists(Fname & ".xls") Then
res = MsgBox(Fname & " already exists." _
& " Do you want to replace it?", vbYesNo, "Duplicate")
If res = vbNo Then GoTo GetFname:
End If
ThisWorkbook.SaveAs Fname
End If
Xit:
Application.DisplayAlerts = True
End Sub

Hope this helps

Don

 

[Thomas Stroebel]

Hi Helmut,

yes, this will work - not as fine as I looked for, but ok.

Thank you very much
Thomas

 

[Thomas Stroebel]

Hi Don,

I already thought about this dialog-routine but never used it - maybe I
should do it now.

Thank you very much
Thomas