PDA

View Full Version : [SOLVED] Cannot get xlSaveDialogAs or GetSaveAsFilename to work as required



El_Diabolo
01-09-2014, 05:22 PM
Hi all,

Hope someone out there can save my sanity. I have been at this for ages and just cannot get what I want. Although this is only actually part of a mini-project, it can be examined on its own for the sake of simplicity. I am trying to intercept the standard Excel SaveAs routine and change the file type. I want the operation to appear as normal to the user, i.e. I do not want them to have to deviate from what they normally do. Please allow me to elaborate as follows:

1. When I use the "xlSaveDialogAs" method I cannot find a way to pass the file type I want. The incoming workbook is ".xlsm", but I want to output it as ".xlsx". Without the possibility of passing the extension I want I have to, as would the user, manually amend the file type. Even allowing for the fact that I don't want to annoy the user in such a way it still displays the message alert box about the conflict about saving xlsm as xlsx, despite having set alerts to false. The code I am using is below:



Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
With Application.Dialogs(xlDialogSaveAs)
.Show
End With
Cancel = True ' Cancel the normal save
End Sub


Interestingly, I use exactly the same code in Word(except xl is wd), incoming being docm and outgoing being docx and it works fine.

So I tried using GetSaveAsFilename. When I use the following code the initial file name does not change:



Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim NewName As String
NewName = Application.GetSaveAsFilename(InitialFileName:="WalterB", FilterIndex:="Excel Workbook(*.xlsx), *.xlsx")
ThisWorkbook.SaveAs Filename:=NewName & ".xlsx"
Cancel = True ' Cancel the normal save
End Sub


However, if I remove the filter index clause the initial name appears as specified.

In both cases for the GetSaveAsFilename the saveas dialog box appears twice. Again unacceptable.

I thought my requirement was pretty standard and must be done regularly by others, but try as I might I cannot solve it. All I want is to intercept and modify the standard save routine without causing the user any hassle. Surely that must be possible. I would be quite happy to find the solution is very easy and I am a dummy. The alternative is less acceptable - Excel goes in the bucket.

Best regards from a frazzled coding codger.

GTO
01-09-2014, 08:20 PM
Hi there,

Not well tested, but does this help?


Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Static InProcessFlag As Boolean
Dim CurrentDrivePath As String
Dim CurrentFolderPath As String
Dim CurrentFullname As String
Dim ProposedFullname As String

'Cancel our coercion if user is already using SaveAs and prevent recurse
If Not (SaveAsUI Or InProcessFlag) Then

'Set a Static flag to prevent recurse
InProcessFlag = True
CurrentFolderPath = CurDir$
CurrentDrivePath = Left$(CurrentFolderPath, 2)
CurrentFullname = ThisWorkbook.FullName

'optional, in case we want the GetSaveAsFilename Dialog to already be aimed at a
'certain folder.
If Not Left$(CurrentFullname, InStrRev(CurrentFullname, "\") - 1) = CurrentFolderPath Then
ChDrive Left$(CurrentFullname, 1)
ChDir Left$(CurrentFullname, InStrRev(CurrentFullname, "\"))
End If

ProposedFullname = Application.GetSaveAsFilename(InitialFileName:="WalterB", _
FileFilter:="Excel Workbook (*.xlsx), *.xlsx")

If Not ProposedFullname = "False" Then
'Prevent issues if the filename already exists
If Len(Dir(ProposedFullname)) Then
MsgBox "File already exists, use another name.", vbCritical, "Error"
Else
'NOT tested, as I do not have access to pre 2010 currently
If Val(Application.Version) >= 12 Then
ThisWorkbook.SaveAs ProposedFullname, 51
Else
ProposedFullname = Left$(ProposedFullname, InStrRev(ProposedFullname, ".") - 1) & ".xls"
ThisWorkbook.SaveAs ProposedFullname, 51
End If
End If

End If
'Cancel the originally called save and un-set our flag on the way out.
Cancel = True
InProcessFlag = False
End If
End Sub

El_Diabolo
01-10-2014, 03:44 AM
Thanks, GTO. Great code. Hugely appreciated. It stops the recursion of the dialog box, which is terrific, but still saves the file as ".xlsm", I'm afraid, despite having been told otherwise via format enumeration "51". Unfortunately, it is vital that it saves as ".xlsx".( I apologise for not stating that I am using Office 2010, 32-bit, stand-alone laptop.) Puzzles me why Word is happy to change file formats, but Excel is not. Any other ideas?

Best regards.
PS: Love your donkey - just how I feel.

GTO
01-10-2014, 04:13 AM
Hi El Diabolo,

I did not try anything in Word, so unsure of any differences. I wrote the code at a PC several hours ago, where I the PC was using WIN7 64-bit for the OS and Excel was 2010 32-bit. The default saveas format was .xlsx and the file was saved as .xlsm.

I am at home now, and recreated the file in: WIN7 32-bit, Excel 2010 (32-bit) and even changed the default SaveAs format to .xlsm. Both the original file and the currently constructed file are .xlsm.

I am at a loss as to your issue. Could you attach the file to your next post?

snb
01-10-2014, 04:44 AM
If you turn the application.displayalerts on you will be asked to save the workbook as a macro free workbook (although it contains the code in de beforeclose event).


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Dialogs(xlDialogSaveAs).Show
Cancel = True
End Sub

El_Diabolo
01-10-2014, 05:07 AM
Hi GTO. Thanks again. Rather than attach the file I am working with I have attached a virgin file - the only code in it is yours. I thought that would provide clarity, but maybe not. In real life my incoming workbook has to be an ".xlsm" file because it contains code which does stuff. However, the newly saved file must not contain this code. The attached example has had all such code stripped from it just in case it was running interference. It baffles me.

Best regards.

GTO
01-10-2014, 05:28 AM
Hi again,

I saved the workbook. Opened it, typed a value in a cell, and saved (leaving the initial filename WalterB.xlsx). As snb states, the "The following features cannot..." application msgbox displays. If I pick <Yes> (continue), it saves as an xlsx. Something seems weird on your end.

That said, I must hit the rack (sorry). In parting, is the code in the incoming file in Standard Modules, or under the sheet(s)/workbook (Object modules)? Just a thought, as if the code is in Standard Modules, maybe copy the sheets to a created/unsaved new workbook, ditch the blank sheet(s) the new workbook was created with, then save that.

Mark

snb
01-10-2014, 05:53 AM
Why don't you use the beforeClose event ?

El_Diabolo
01-10-2014, 06:14 AM
snb: Thanks for your replies. I am trying to keep the save routine normal from the user's perspective, i.e. they do File/SaveAs, give it a name and finish. If I use the beforeClose event then the normal routine is destroyed. Unless I am misunderstanding your suggestion. Also, I don't want "The following features cannot...." dialog box to appear. That also breaks normality for the user. Sorry for not replying sooner, but for some reason I no longer receive emails when a reply has been posted.

GTO: Agreed. "The following features cannot...." dialog appears for me too, but I just want Excel to follow the instructions it has been given and save it as an ".xlsx" file, without troubling the user. Sleep well.

Best regards, El_D

El_Diabolo
01-10-2014, 06:49 AM
GTO: Sorry, I'm sure you have had enough, but my above reply was not clear. If I use "Save" then the initial file name appears correctly as does the ".xlsx" extension. Also, if I set Alerts to False, then "The following features...." dialog does not appear and the file is saved as desired. That's all great. However, when I use "SaveAs", as the user would be doing, i.e. the normal way to save a modified workbook, then neither the initial file name nor the ".xlsx" extension appears. Of course I can manually select the ".xlsx" file type, but again that defeats the purpose of keeping things normal. So near and yet....

Best regards.

Bob Phillips
01-10-2014, 07:53 AM
I have tried your stripped down code, and it saves the file as .xlsx for me, in Excel 2010. As Mark said, I get the message about losing VBProject (easily overcome with DisplayAlerts), but it works fine.

snb
01-10-2014, 07:54 AM
So why would you bother the user asking to give a name to a file that can be saved more systematically by an algorithm ?

Kenneth Hobs
01-10-2014, 08:02 AM
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim NewName As Variant, iName As String
Application.EnableEvents = False

iName = CreateObject("Scripting.FileSystemObject").GetBasename(ThisWorkbook.Name)
NewName = fSaveAs(ThisWorkbook.Path & "\" & iName & ".xlsx")

Application.EnableEvents = True
Cancel = True ' Cancel the normal save
End Sub

Function fSaveAs(initialFilename As String) As Variant
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.ButtonName = "&Save As"
.initialFilename = initialFilename
.Title = "File Save As"
.AllowMultiSelect = False
.Show
Application.DisplayAlerts = True
fSaveAs = .SelectedItems(1)
End With
End Function

El_Diabolo
01-10-2014, 10:54 AM
Thanks to all for your replies.

xkl: Did you do a Save, or a SaveAs? I get it to work for Save, but not for SaveAs.

snb: Sorry, but I don't understand your question. Could you enlarge on it please?

Kenneth: Hello again and, as ever, your code is amazing. When I ran it, it executed OK, but didn't actually save the file. So I took the liberty of amending it slightly, as below. (I hope you don't mind).




Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim NewName As Variant, iName As String
Application.EnableEvents = False

iName = CreateObject("Scripting.FileSystemObject").GetBasename(ThisWorkbook.Name)
NewName = fSaveAs(ThisWorkbook.Path & "\" & iName & ".xlsx")

ThisWorkbook.SaveAs NewName, 51 ' I added this line
Application.DisplayAlerts = True ' I moved this line out of the Function

Application.EnableEvents = True
Cancel = True ' Cancel the normal save
End Sub

Function fSaveAs(initialFilename As String) As Variant
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.ButtonName = "&Save As"
.initialFilename = initialFilename
.Title = "File Save As"
.AllowMultiSelect = False
.Show
fSaveAs = .SelectedItems(1)
End With
End Function



That works great, but if the user selects Cancel from the SaveAs dialog box then we get: Run-time error 5:Invalid procedure call or argument - fSaveAs = .SelectedItems(1). I don't know how to solve this.

Best regards to all and thanks again for all the help.

Kenneth Hobs
01-10-2014, 12:12 PM
I had thought of something like that. If it works, go for it.


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim NewName As Variant, iName As String
Application.EnableEvents = False

iName = CreateObject("Scripting.FileSystemObject").GetBasename(ThisWorkbook.Name)
NewName = fSaveAs(ThisWorkbook.Path & "\" & iName & ".xlsx")
'If NewName <> False Then _
ThisWorkbook.SaveAs NewName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Application.EnableEvents = True
Cancel = True ' Cancel the normal save
End Sub

Function fSaveAs(initialFilename As String) As Variant
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.ButtonName = "&Save As"
.initialFilename = initialFilename
.Title = "File Save As"
.AllowMultiSelect = False
.Show
.Execute
Application.DisplayAlerts = True
On Error Resume Next
fSaveAs = .SelectedItems(1)
End With
End Function

El_Diabolo
01-10-2014, 02:15 PM
Kenneth: I just replied , but I don't see it. So here is another one. Your solution works perfectly. Thank you so much. I don't know how you get to know all that stuff. It's amazing - really. Your time and efforts are very much appreciated. Fantastic to have such expert help.

Best regards and best wishes.
Walter