Call in Variable File Directory and Filename from Cell into Save As Prompt

**cyphus64** · 03-08-2013, 08:15 PM

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!

**JBeaucaire** · 03-08-2013, 09:06 PM

In this macro, notice the Cancel as Boolean listed in the header? This means you have the option to CANCEL the primary SAVE command within this macro. So, before you end the sub, add a Cancel = True and it will suppress the other SAVE functions, leaving only the macro code to work every time.

**JBeaucaire** · 03-08-2013, 09:37 PM

Try this:

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fFullPathName As String, fTEST As String

Application.EnableEvents = False
fFullPathName = Sheets("Input Sheet").Range("B1").Value

'Test if file already exists
If Len(Dir(fFullPathName)) > 0 Then
    If MsgBox("The file '" & fFullPathName & "' already exists. Do you wish to overwrite it?", vbExclamation + vbYesNo) = vbYes Then
        Application.DisplayAlerts = False
        Cancel = True
        ThisWorkbook.Save
        Application.EnableEvents = True
        Exit Sub
    End If

End If

fTEST = SaveItAs(fFullPathName)
Application.DisplayAlerts = False
If fTEST <> "False" And fTEST > "" Then ThisWorkbook.SaveAs fTEST
Cancel = True
Application.EnableEvents = True
End Sub

Function SaveItAs(MyFile As String) As String
On Error GoTo ErrorExit

    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .ButtonName = "&Save As"
        .InitialFileName = MyFile
        .Title = "File Save As"
        '.Execute
        .Show
        SaveItAs = .SelectedItems(1)
    End With

ErrorExit:
End Function