conditional sequential file saving with vba

[mjd]

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:

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

 

[Logit]

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]

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:

 [B]ActiveWorkbook.SaveAs Filename:=strPath & strFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False[/B]

 

[Logit]

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 :

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]

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):

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