I want to save a workbook as xlsm, so I intercepted the SaveAs dialog. The point is that if the user clicks one of the 'Recent Folders', but I can't catch the selected folder.
Idea anyone?
I use code as shown below.
Regards,
Goos.
Code: Select all
Option Explicit
Private Const OBJECT_NAME As String = "ThisWorkbook"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sSaveAsName As String
Dim sFileName As String
Dim sMru As String
10 On Error GoTo ErrorHandler
20 Application.EnableEvents = False
30 Application.DisplayRecentFiles = True
40 If SaveAsUI Then
50 Cancel = True
60 sFileName = CreateValidFileName
70 sSaveAsName = Application.GetSaveAsFilename(InitialFileName:=sFileName, fileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
80 If Not (sSaveAsName = "False" Or sSaveAsName = "Onwaar") Then
90 ThisWorkbook.SaveAs Filename:=sSaveAsName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, AddToMru:=True, Local:=True
100 Call modFunctions.WriteMruFolder(FolderFromFullName(ThisWorkbook.FullName))
110 End If
120 End If
ExitProcedure:
130 On Error Resume Next
140 Application.EnableEvents = True
150 Exit Sub
ErrorHandler:
160 Select Case Err.Number
Case Is = 0
170 Case Is = 1004
180 Case Else
190 Call modFunctions.HandleError(OBJECT_NAME, "Workbook_BeforeSave", False, "")
200 End Select
210 Resume ExitProcedure
End Sub
Private Function CreateValidFileName()
Dim sMru As String
10 On Error GoTo ErrorHandler
20 CreateValidFileName = Me.Name
30 If InStr(Me.Name, ".") = 0 Then
' Supposed new workbook from template
' remove the last digit
40 If IsNumeric(Right(Me.Name, 1)) Then
50 CreateValidFileName = Left(Me.Name, Len(Me.Name) - 1)
60 End If
70 Else
' Trim the extension
80 CreateValidFileName = Left(Me.Name, InStrRev(Me.Name, ".") - 1)
90 End If
' **************************************************
' sMru should be the selected 'Recent Folder'
' Instead I use the last used folder
' **************************************************
100 sMru = modFunctions.ReadMruFolder
110 If Len(sMru & vbNullString) >= 3 Then
120 CreateValidFileName = sMru & CreateValidFileName
130 End If
ExitProcedure:
140 On Error Resume Next
150 Exit Function
ErrorHandler:
160 Select Case Err.Number
Case Is = 0
170 Case Else
180 Call HandleError(OBJECT_NAME, "CreateValidFileName", False, "")
190 End Select
200 Resume ExitProcedure
End Function
