VBA to save active file wtih file name and date

[General Ledger]

Dear All,

I am trying to create code that will take the name of the active file (csv, txt, xls, xlsx), concatenate the current date and time, and open Save As dialog box with a default folder.

The below code does all that except finding the name of the active file. How can I pull just the name of the file from the active file?

Sub SaveAsDialog()
    Dim strFolder As String
    FileName = "Accounts Payable " & Format(Now, "yyyy-mm-dd hh mm") & ".xlsx"
    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .InitialFileName = "P:\Audit 2011\" & FileName
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
        .Execute
    End With
End Sub

Thank you,

GL

 

[VoG]

Peryaps like this

.InitialFileName = ActiveWorkbook.FullName

 

[General Ledger]

I updated my code based on the response from VoG.

My problem is the FullName returns the name of the file with the file extention (.xls) How can I strip off the file extention from the file name?

Sub SaveAsDialog()
    Dim strFolder As String
    FileName = ActiveWorkbook.FullName & " " & Format(Now, "yyyy-mm-dd hh mm") & ".xlsx"
    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .InitialFileName = "P:\Audit 2011\" & FileName
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
        .Execute
    End With
 
End Sub

 

[VoG]

Try like this

Sub SaveAsDialog()
    Dim strFolder As String
    Dim i As Long
    i = InStr(ActiveWorkbook.Name, ".xlsx")
    Filename = Left(ActiveWorkbook.Name, i - 1) & " " & Format(Now, "yyyy-mm-dd hh mm") & ".xlsx"
    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .InitialFileName = "P:\Audit 2011\" & Filename
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
        .Execute
    End With
 
End Sub

 

[General Ledger]

VoG, you did it. Here is my final version. Thanks so much.

Sub SaveAsDialog()
    Dim strFolder As String
    Dim i As Long
 
    'Find the position of the period in the file name
    i = InStr(ActiveWorkbook.Name, ".")
 
    'Create a default file name by concatenating the file name without the extention _
        plus the current date and time, and plus the xlsx extention
    FileName = Left(ActiveWorkbook.Name, i - 1) & " " & Format(Now, "yyyy-mm-dd hh mm") & ".xlsx"
 
    'Open Save As dialog to a default folder with default file name
    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .InitialFileName = "P:\Audit 2011\" & FileName
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
        .Execute
    End With    
End Sub

 

[paulaedwards]

ok my saving works fine as the code shown... but my issue is the File Save as dialog box comes up and then I manually have to click "Save" and then it will save the excel document in the relevant folder I specified. I need my code to automatically select "save" and not show a dialog box and save in the folder.

I think the issue lies here in the code


.InitialView = msoFileDialogViewDetails If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub</pre>