Hi Everyone,
This is my first time posting in this forum (or any for that matter), but I have used the forum extensively and have really appreciated the value of the knowledge here. I really need some help that I'm sure will be simple, but I am very new to VBA so it's difficult for me to piece together.
I basically just want a macro that will activate every time the Save or SaveAs functions in Excel are pressed, that will open up the SaveAs Dialogue with a file name and file directory in Sheets("Input Sheet").Range("BN1"). The value in BN1 is a concatenated filename and directory that changes based on an order number and today's date (currently "13-MELLON INV\13-Trans Stmts\1st Qtr\02-FEB\1302 - 1111A Trans Statements.xls). I would like the "SaveAs" dialog to open up to "S:\13-MELLON INV\13-Trans Stmts\1st Qtr\02-FEB\", with "1302 - 1111A Trans Statements.xls" as the suggested filename to be saved. There is a chance the name will need to be modified on an occasional report, i.e. one that has an anomaly that needs to be checked might have the filename altered slightly, so I do need the dialog rather than just having the macro save it completely.
I have played around with some other code I have found online, which I will list below, but run into a couple of problems. One, because it is a BeforeSave event, it brings it up the way I would like, but then immediately comes up to save again, at which point I have to either cancel the second save or select to override the file the event just saved. I'd like the saveas from the event to be the only save. Second, I don't know if it's possible to make a normal Save require the SaveAs dialog as well, since these are important files, but if there is a way to do it (or disable normal Save altogether), I would also like to include that. Here is what I have:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fName As String
Dim fPath As String
Dim fSave As Boolean
fName = Sheets("Input Sheet").Range("BN1").Value)
fPath = "S:\" & fName
'Test if file already exists
If Dir(fPath) <> "" Then
If MsgBox("The file '" & fPath & "' already exists. Do you wish to overwrite it?", vbExclamation + vbYesNo) = vbYes Then
fSave = True
If Windows(Dir(fPath, vbArchive)) Is Nothing Then 'Check if the file fPath is currently open
Kill fPath
End If
Else
fSave = False
End If
Else
fSave = True
End If
If fSave Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=fPath, FileFormat:=xlExcel8 '
Application.DisplayAlerts = True
End If
End Sub
Thanks for any help you can give me!
Bookmarks