conditional sequential file saving with vba

mjd

Board Regular
Joined
Feb 23, 2010
Messages
73
Hello all,

I have been asked to embed logic into a macro enabled spreadsheet that will save a file with a standardized name ("projectmmddyyyy.xlsx") -- that works fine and well if we only have one version of this report on a given date, but if we have 2 or more, we need to append a differentiating character to the file name (b,c,d etc.)

To that end, I have worked out this block of code which scans the folder where this will be saved to look for a pre-existing report with the standard filename for that date, and if so, it will append the character:

VBA Code:
Sub Test1()
    Dim strPath As String
    Dim dtDate As Date
    Dim strFileName As String
    Dim strFileExists As String
    Dim strFile As String

    strPath = "U:\Test\"

    dtDate = Date

    strFileName = ("U:\Test\Project" & Format(dtDate, "mmddyyyy") & ".xlsx")
    strFileExists = Dir(strFileName)

    If strFileExists = "" Then
        strFile = ("U:\Test\Project" & Format(dtDate, "mmddyyyy") & ".xlsx")
    Else
        strFile = ("U:\Test\Project" & Format(dtDate, "mmddyyyy") & "B.xlsx")
    End If

    ActiveWorkbook.SaveAs Filename:=strPath & strFile, FileFormat _
    :=xlOpenXMLWorkbook, CreateBackup:=False

    Application.DisplayAlerts = False

End Sub

This is failing at the "ActiveWorkbook.SaveAs Filename:=strPath & strFile, FileFormat _ :=xlOpenXMLWorkbook, CreateBackup:=False" block, and I cannot for the life of me figure out why. Can anyone shed any insight on that? Additionally, is there a better way to handle this on the whole? I realize the way I coded this will only account for the standard & standardB filename, so I will need to add additional steps to account for more records.

Thanks in advance!
Mike
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,537
Untested here :

Change :

Else
strFile = ("U:\Test\Project" & Format(dtDate, "mmddyyyy") & "B.xlsx")


To:

Else
strFile = ("U:\Test\Project" & Format(dtDate, "mmddyyyy") & "B" & ".xlsx")



Also change :

ActiveWorkbook.SaveAs Filename:=strPath & strFile, FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False


To:

ActiveWorkbook.SaveAs Filename:=strPath & strFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 

mjd

Board Regular
Joined
Feb 23, 2010
Messages
73
Untested here :

Change :

Else
strFile = ("U:\Test\Project" & Format(dtDate, "mmddyyyy") & "B.xlsx")


To:

Else
strFile = ("U:\Test\Project" & Format(dtDate, "mmddyyyy") & "B" & ".xlsx")



Also change :

ActiveWorkbook.SaveAs Filename:=strPath & strFile, FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False


To:

ActiveWorkbook.SaveAs Filename:=strPath & strFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Thanks for responding. Now it is tripping up with a Run-time error '1004': Method 'SaveAs' of object '_Workbook' failed on the following line of code:
VBA Code:
 [B]ActiveWorkbook.SaveAs Filename:=strPath & strFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False[/B]
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,537
I had more time now to review your macro. First, your macro does not utilize this line (even though you have included it in the macro) :

strPath = "U:\Test\"

So you can do away with it and the DIM statement for strPath.

I don't have a "U" drive so I utilized the Desktop for testing purpose ... and this code version works here :

VBA Code:
Sub Test1()
    Dim strPath As String
    Dim dtDate As Date
    Dim strFileName As String
    Dim strFileExists As String
    Dim strFile As String

    dtDate = Date

    strFileName = ("C:\Users\jimga\Desktop\Project\" & Format(dtDate, "mmddyyyy") & ".xlsm")
    strFileExists = Dir(strFileName)

    If strFileExists = "" Then
        strFile = ("C:\Users\jimga\Desktop\Project\" & Format(dtDate, "mmddyyyy") & ".xlsm                           ")
    Else
        strFile = ("C:\Users\jimga\Desktop\Project\" & Format(dtDate, "mmddyyyy") & "B.xlsm")
    End If

    ActiveWorkbook.SaveAs Filename:=strFile, FileFormat:=52, CreateBackup:=False

    Application.DisplayAlerts = False

End Sub

Edit the path to suit your computer environment.
 

mjd

Board Regular
Joined
Feb 23, 2010
Messages
73
Thanks for looking into this deeper. I couldn't get your code to work for me, but I was able to adapt some blocks I found else where to get me most of the way to where I need to be. The only thing that is missing is the automation of the sequential filenames, but I have made the system prompt to save as when the root file name exists in the target folder. Ideally, the macro would be able to append "A","B", etc without a prompt box. But this will work for now (Credit to Ron DeBruin for the function template):

VBA Code:
Function FileExist(FilePath As String) As Boolean
'PURPOSE: Test to see if a file exists or not
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
'RESOURCE: http://www.rondebruin.nl/win/s9/win003.htm

Dim TestStr As String

FilePath = "U:\Test\Project" & Format(Now(), "mmddyyyy") & ".xlsx"
  On Error Resume Next
    TestStr = Dir(FilePath)
  On Error GoTo 0

'Determine if File exists
  If TestStr = "" Then
    FileExist = False
  Else
    FileExist = True
  End If

End Function

Sub Test()
Dim strPath As String
Dim strFileName As String
Dim SvName As String

strPath = "U:\Test\"
strFileName = "Project" & Format(Now(), "mmddyyyy") & "A-B-C-D CHOSE NEXT IN SEQUENCE"
SvName = strPath & strFileName

If FileExist("U:\Test\Project" & Format(Now(), "mmddyyyy") & ".xlsx") = False Then
    ActiveWorkbook.SaveAs Filename:="U:\Test\Project" & Format(Now(), "mmddyyyy") & ".xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
    Else: Application.Dialogs(xlDialogSaveAs).Show SvName
        End If
End Sub
 
Solution

Forum statistics

Threads
1,176,105
Messages
5,901,407
Members
434,891
Latest member
mahmoud Alhamaky

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top