Help needed with 'Save As' dialog

T

terry w

hello gurus

I'm having trouble with the following code. The last line I've show works
perfectly - the 'Save As' dialog comes up, and the 'File Name' drop-down box
correctly shows the value of strFileName. But, I can't figure out how to get
the 'Save In' drop down box to show the value of strSaveLocation.

strSaveLocation = "C:\EmpData\2009"
strFileName = "Report_" & strDate & "_" & strEmpName & ".xls"

Application.Dialogs(xlDialogSaveAs).Show strFileName

Any clues welcomed!
Terry W.
 
T

Tom Hutchins

If the file path & name are already established, why show a Save As dialog?
You can do the Save As directly:

ActiveWorkbook.SaveAs Filename:=strSaveLocation & "\" & strFileName, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Hope this helps,

Hutch
 
T

terry w

hi Tom - thanks for replying. This code works very well, but it actually
goes ahead and Saves before the user has a chance to change the suggested
values in the 'Save In' and 'File Name' drop-down boxes. I was hoping to
show the Save As Dialog with these boxes filled in, but give the user the
option to make changes before clicking Save. I've noticed that...

Application.Dialogs(xlDialogSaveAs).Show strFileName

will show the dialog box this way, waiting for the user to click Save or
Cancel. I just can't get the 'Save In' drop-down box to show the value of
strSaveLocation.

Terry W
 
J

Jon Peltier

Terry -

You should probably use GetSaveAsFileName. What this does is present the
Save As dialog to the user, and it gets the name and path that the user
wants. It does not save any files, so you have to do that. But it is
more flexible.

This example is a routine to export a chart, which makes use of
GetSaveAsFileName. It has some code to check for a duplicate file name,
but you could leave some of that out on its own.

'=========================================================================
Sub ExportChart()
Dim sChartName As String
Dim sFileName As String
Dim sPathName As String
Dim sPrompt As String
Dim sCurDir As String
Dim iOverwrite As Long

If ActiveSheet Is Nothing Then GoTo ExitSub
If ActiveChart Is Nothing Then GoTo ExitSub

' save current directory, restore it later
sCurDir = CurDir

' change to desired directory
' (in this case, active workbook's directory)
sPathName = ActiveWorkbook.Path
If Len(sPathName) > 0 Then
ChDrive sPathName
ChDir sPathName
End If

' proposed file name
sFileName = "MyChart.png"

' loop until unique name is entered
Do
sChartName = Application.GetSaveAsFilename(sFileName, _
"All Files (*.*),*.*", , _
"Browse to a folder and enter a file name")

If Len(sChartName) = 0 Then GoTo ExitSub
If sChartName = "False" Then GoTo ExitSub

' make sure valid filter (extension) is used
Select Case True
Case UCase$(Right(sChartName, 4)) = ".PNG"
Case UCase$(Right(sChartName, 4)) = ".GIF"
Case UCase$(Right(sChartName, 4)) = ".JPG"
Case UCase$(Right(sChartName, 4)) = ".JPE"
Case UCase$(Right(sChartName, 5)) = ".JPEG"
Case Else
If Right$(sChartName, 1) <> "." Then
sChartName = sChartName & "."
End If
sChartName = sChartName & "png"
End Select

' unique name - okay to save it
If Not FileExists(sChartName) Then Exit Do

' tell user that the filename is in use

' parse filename
sFileName = FullNameToFileName(sChartName)
sPathName = FullNameToPath(sChartName)

' construct message
sPrompt = "A file named '" & sFileName & "' already exists in '" _
& sPathName & "'"
sPrompt = sPrompt & vbNewLine & vbNewLine & _
"Do you want to overwrite the existing file?"

' ask user what to do
iOverwrite = MsgBox(sPrompt, vbYesNoCancel + vbQuestion, _
"Image File Exists")

Select Case iOverwrite
Case vbYes
' overwrite existing file
Exit Do
Case vbNo
' do nothing, loop again to get new filename
Case vbCancel
' bail out
GoTo ExitSub
End Select
Loop

' finally, save the file using filename from above
ActiveChart.Export sChartName

ExitSub:
' restore previous current directory
ChDrive sCurDir
ChDir sCurDir
End Sub
'=========================================================================
Function FileExists(ByVal FileSpec As String) As Boolean
' Karl Peterson MS VB MVP
Dim Attr As Long
' Guard against bad FileSpec by ignoring errors
' retrieving its attributes.
On Error Resume Next
Attr = GetAttr(FileSpec)
If Err.Number = 0 Then
' No error, so something was found.
' If Directory attribute set, then not a file.
FileExists = Not ((Attr And vbDirectory) = vbDirectory)
End If
End Function
'=========================================================================
Function FullNameToFileName(sFullName As String) As String
Dim k As Integer
Dim sTest As String
If InStr(1, sFullName, "[") > 0 Then
k = InStr(1, sFullName, "[")
sTest = Mid(sFullName, k + 1, InStr(1, sFullName, "]") - k - 1)
Else
For k = Len(sFullName) To 1 Step -1
If Mid(sFullName, k, 1) = "\" Then Exit For
Next k
sTest = Mid(sFullName, k + 1, Len(sFullName) - k)
End If
FullNameToFileName = sTest
End Function
'=========================================================================
Function FullNameToPath(sFullName As String) As String
''' does not include trailing backslash
Dim k As Integer
For k = Len(sFullName) To 1 Step -1
If Mid(sFullName, k, 1) = "\" Then Exit For
Next k
If k < 1 Then
FullNameToPath = ""
Else
FullNameToPath = Mid(sFullName, 1, k - 1)
End If
End Function
'=========================================================================

- Jon
 
J

Jon Peltier

I wrote this up on my blog:

Robust VBA Save-As Technique
http://peltiertech.com/WordPress/robust-vba-save-as-technique/

- Jon
-------
Jon Peltier
Peltier Technical Services, Inc.
http://peltiertech.com/



Jon said:
Terry -

You should probably use GetSaveAsFileName. What this does is present the
Save As dialog to the user, and it gets the name and path that the user
wants. It does not save any files, so you have to do that. But it is
more flexible.

This example is a routine to export a chart, which makes use of
GetSaveAsFileName. It has some code to check for a duplicate file name,
but you could leave some of that out on its own.

'=========================================================================
Sub ExportChart()
Dim sChartName As String
Dim sFileName As String
Dim sPathName As String
Dim sPrompt As String
Dim sCurDir As String
Dim iOverwrite As Long

If ActiveSheet Is Nothing Then GoTo ExitSub
If ActiveChart Is Nothing Then GoTo ExitSub

' save current directory, restore it later
sCurDir = CurDir

' change to desired directory
' (in this case, active workbook's directory)
sPathName = ActiveWorkbook.Path
If Len(sPathName) > 0 Then
ChDrive sPathName
ChDir sPathName
End If

' proposed file name
sFileName = "MyChart.png"

' loop until unique name is entered
Do
sChartName = Application.GetSaveAsFilename(sFileName, _
"All Files (*.*),*.*", , _
"Browse to a folder and enter a file name")

If Len(sChartName) = 0 Then GoTo ExitSub
If sChartName = "False" Then GoTo ExitSub

' make sure valid filter (extension) is used
Select Case True
Case UCase$(Right(sChartName, 4)) = ".PNG"
Case UCase$(Right(sChartName, 4)) = ".GIF"
Case UCase$(Right(sChartName, 4)) = ".JPG"
Case UCase$(Right(sChartName, 4)) = ".JPE"
Case UCase$(Right(sChartName, 5)) = ".JPEG"
Case Else
If Right$(sChartName, 1) <> "." Then
sChartName = sChartName & "."
End If
sChartName = sChartName & "png"
End Select

' unique name - okay to save it
If Not FileExists(sChartName) Then Exit Do

' tell user that the filename is in use

' parse filename
sFileName = FullNameToFileName(sChartName)
sPathName = FullNameToPath(sChartName)

' construct message
sPrompt = "A file named '" & sFileName & "' already exists in '" _
& sPathName & "'"
sPrompt = sPrompt & vbNewLine & vbNewLine & _
"Do you want to overwrite the existing file?"

' ask user what to do
iOverwrite = MsgBox(sPrompt, vbYesNoCancel + vbQuestion, _
"Image File Exists")

Select Case iOverwrite
Case vbYes
' overwrite existing file
Exit Do
Case vbNo
' do nothing, loop again to get new filename
Case vbCancel
' bail out
GoTo ExitSub
End Select
Loop

' finally, save the file using filename from above
ActiveChart.Export sChartName

ExitSub:
' restore previous current directory
ChDrive sCurDir
ChDir sCurDir
End Sub
'=========================================================================
Function FileExists(ByVal FileSpec As String) As Boolean
' Karl Peterson MS VB MVP
Dim Attr As Long
' Guard against bad FileSpec by ignoring errors
' retrieving its attributes.
On Error Resume Next
Attr = GetAttr(FileSpec)
If Err.Number = 0 Then
' No error, so something was found.
' If Directory attribute set, then not a file.
FileExists = Not ((Attr And vbDirectory) = vbDirectory)
End If
End Function
'=========================================================================
Function FullNameToFileName(sFullName As String) As String
Dim k As Integer
Dim sTest As String
If InStr(1, sFullName, "[") > 0 Then
k = InStr(1, sFullName, "[")
sTest = Mid(sFullName, k + 1, InStr(1, sFullName, "]") - k - 1)
Else
For k = Len(sFullName) To 1 Step -1
If Mid(sFullName, k, 1) = "\" Then Exit For
Next k
sTest = Mid(sFullName, k + 1, Len(sFullName) - k)
End If
FullNameToFileName = sTest
End Function
'=========================================================================
Function FullNameToPath(sFullName As String) As String
''' does not include trailing backslash
Dim k As Integer
For k = Len(sFullName) To 1 Step -1
If Mid(sFullName, k, 1) = "\" Then Exit For
Next k
If k < 1 Then
FullNameToPath = ""
Else
FullNameToPath = Mid(sFullName, 1, k - 1)
End If
End Function
'=========================================================================

- Jon
-------
Jon Peltier
Peltier Technical Services, Inc.
http://peltiertech.com/



terry said:
hi Tom - thanks for replying. This code works very well, but it
actually goes ahead and Saves before the user has a chance to change
the suggested values in the 'Save In' and 'File Name' drop-down
boxes. I was hoping to show the Save As Dialog with these boxes
filled in, but give the user the option to make changes before
clicking Save. I've noticed that...

Application.Dialogs(xlDialogSaveAs).Show strFileName

will show the dialog box this way, waiting for the user to click Save
or Cancel. I just can't get the 'Save In' drop-down box to show the
value of strSaveLocation.

Terry W
 
T

terry w

thanks Jon - that was really helpful
Terry W

Jon Peltier said:
I wrote this up on my blog:

Robust VBA Save-As Technique
http://peltiertech.com/WordPress/robust-vba-save-as-technique/

- Jon
-------
Jon Peltier
Peltier Technical Services, Inc.
http://peltiertech.com/



Jon said:
Terry -

You should probably use GetSaveAsFileName. What this does is present the
Save As dialog to the user, and it gets the name and path that the user
wants. It does not save any files, so you have to do that. But it is
more flexible.

This example is a routine to export a chart, which makes use of
GetSaveAsFileName. It has some code to check for a duplicate file name,
but you could leave some of that out on its own.

'=========================================================================
Sub ExportChart()
Dim sChartName As String
Dim sFileName As String
Dim sPathName As String
Dim sPrompt As String
Dim sCurDir As String
Dim iOverwrite As Long

If ActiveSheet Is Nothing Then GoTo ExitSub
If ActiveChart Is Nothing Then GoTo ExitSub

' save current directory, restore it later
sCurDir = CurDir

' change to desired directory
' (in this case, active workbook's directory)
sPathName = ActiveWorkbook.Path
If Len(sPathName) > 0 Then
ChDrive sPathName
ChDir sPathName
End If

' proposed file name
sFileName = "MyChart.png"

' loop until unique name is entered
Do
sChartName = Application.GetSaveAsFilename(sFileName, _
"All Files (*.*),*.*", , _
"Browse to a folder and enter a file name")

If Len(sChartName) = 0 Then GoTo ExitSub
If sChartName = "False" Then GoTo ExitSub

' make sure valid filter (extension) is used
Select Case True
Case UCase$(Right(sChartName, 4)) = ".PNG"
Case UCase$(Right(sChartName, 4)) = ".GIF"
Case UCase$(Right(sChartName, 4)) = ".JPG"
Case UCase$(Right(sChartName, 4)) = ".JPE"
Case UCase$(Right(sChartName, 5)) = ".JPEG"
Case Else
If Right$(sChartName, 1) <> "." Then
sChartName = sChartName & "."
End If
sChartName = sChartName & "png"
End Select

' unique name - okay to save it
If Not FileExists(sChartName) Then Exit Do

' tell user that the filename is in use

' parse filename
sFileName = FullNameToFileName(sChartName)
sPathName = FullNameToPath(sChartName)

' construct message
sPrompt = "A file named '" & sFileName & "' already exists in '" _
& sPathName & "'"
sPrompt = sPrompt & vbNewLine & vbNewLine & _
"Do you want to overwrite the existing file?"

' ask user what to do
iOverwrite = MsgBox(sPrompt, vbYesNoCancel + vbQuestion, _
"Image File Exists")

Select Case iOverwrite
Case vbYes
' overwrite existing file
Exit Do
Case vbNo
' do nothing, loop again to get new filename
Case vbCancel
' bail out
GoTo ExitSub
End Select
Loop

' finally, save the file using filename from above
ActiveChart.Export sChartName

ExitSub:
' restore previous current directory
ChDrive sCurDir
ChDir sCurDir
End Sub
'=========================================================================
Function FileExists(ByVal FileSpec As String) As Boolean
' Karl Peterson MS VB MVP
Dim Attr As Long
' Guard against bad FileSpec by ignoring errors
' retrieving its attributes.
On Error Resume Next
Attr = GetAttr(FileSpec)
If Err.Number = 0 Then
' No error, so something was found.
' If Directory attribute set, then not a file.
FileExists = Not ((Attr And vbDirectory) = vbDirectory)
End If
End Function
'=========================================================================
Function FullNameToFileName(sFullName As String) As String
Dim k As Integer
Dim sTest As String
If InStr(1, sFullName, "[") > 0 Then
k = InStr(1, sFullName, "[")
sTest = Mid(sFullName, k + 1, InStr(1, sFullName, "]") - k - 1)
Else
For k = Len(sFullName) To 1 Step -1
If Mid(sFullName, k, 1) = "\" Then Exit For
Next k
sTest = Mid(sFullName, k + 1, Len(sFullName) - k)
End If
FullNameToFileName = sTest
End Function
'=========================================================================
Function FullNameToPath(sFullName As String) As String
''' does not include trailing backslash
Dim k As Integer
For k = Len(sFullName) To 1 Step -1
If Mid(sFullName, k, 1) = "\" Then Exit For
Next k
If k < 1 Then
FullNameToPath = ""
Else
FullNameToPath = Mid(sFullName, 1, k - 1)
End If
End Function
'=========================================================================

- Jon
-------
Jon Peltier
Peltier Technical Services, Inc.
http://peltiertech.com/



terry said:
hi Tom - thanks for replying. This code works very well, but it
actually goes ahead and Saves before the user has a chance to change
the suggested values in the 'Save In' and 'File Name' drop-down
boxes. I was hoping to show the Save As Dialog with these boxes
filled in, but give the user the option to make changes before
clicking Save. I've noticed that...

Application.Dialogs(xlDialogSaveAs).Show strFileName

will show the dialog box this way, waiting for the user to click Save
or Cancel. I just can't get the 'Save In' drop-down box to show the
value of strSaveLocation.

Terry W


:

If the file path & name are already established, why show a Save As
dialog? You can do the Save As directly:

ActiveWorkbook.SaveAs Filename:=strSaveLocation & "\" & strFileName, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Hope this helps,

Hutch

:

hello gurus

I'm having trouble with the following code. The last line I've show
works perfectly - the 'Save As' dialog comes up, and the 'File Name'
drop-down box correctly shows the value of strFileName. But, I
can't figure out how to get the 'Save In' drop down box to show the
value of strSaveLocation.

strSaveLocation = "C:\EmpData\2009"
strFileName = "Report_" & strDate & "_" & strEmpName & ".xls"

Application.Dialogs(xlDialogSaveAs).Show strFileName

Any clues welcomed!
Terry W.
.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top