Saving Workbook As Name with Date and Unique Number

[soteman2005]

Hi,

I have this script to copy several worksheets to a new workbook and save it. At the moment, it saves it with the date and time in the filename but I would like to change this so it saves the date and a unique number. How would I get it to do this so that the number starts from 1 each day, and resets to 1 again the next day?

Any help would be greatly appreciated.

Thanks

Sub Create_Factbase()
     
    Dim FileName As String
    
    Application.ScreenUpdating = False
    
    FileName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
    
    Sheets(Array("A", "B", "C")).Copy
    
    ActiveWorkbook.SaveAs FileName:=FileName + "_" + Format(Date, "dd-mm-yy") + _
    "_" + Format(Time, "hh.mm.ss")
     
    Application.ScreenUpdating = True
     
     
End Sub

 

[bandit_1981]

So you would want it to say look like this. 12/13/2005-01 and then if they ran it again it would be 12/13/2005-02 etc?

 

[soteman2005]

Hi,

Yes that would be great. But is it possible to do it so that it resets on 13-12-05 to 01,02,03 etc, then on 14-12-05 it restarts at 01, 02, 03?

Thanks

 

[bandit_1981]

I would think so. This example might put you in the right direction. This example would assume you only are going to save it a max of 50 times in one day. I wrote this cde in notepad so it will have errors prob and wont work more of a logic example.

    FileName = Date & "-" & "01"
    
    If fso.FileExists(FileName) = True Then
        'need to find the last file so we know what number to give it
        For x = 2 To 50
            FileName = Left(FileName, Len(FileName) - 2) & Right("00" & x, 2)
            If fso.FileExists(FileName) = False Then
                'this is the file we save
	     ActiveWorkbook.SaveAs FileName:=FileName		                
                Exit For
            End If
        Next
    Else
	‘it didn’t find a 01 so this is the first save
        ActiveWorkbook.SaveAs FileName:=FileName		                
    End If

 

[soteman2005]

That was less clear than I intended. Here is an example of the filenames that would be generated.

13/12/05-01
13/12/05-02
13/12/05-03
14/12/05-01
14/12/05-02
15/12/05-01
16/12/05-01
16/12/05-02

etc etc.

Thanks

 

[bandit_1981]

The above code should do that. It first searched for the data with a starting UID of 1. If it does not find it it creates the 12/13/2005-01. You can use whatever date format you want. If it does find it it goes into a loop searching for the next number that is not taken. So it would find 02 since 01 is used and wrtie out 12/13/2005-02. Unless i am still missing something?

 

[soteman2005]

This produces an object not found error?

If fso.FileExists(FileName) = True Then

[/code]

 

[bandit_1981]

Add a reference to microsoft runtime scripting. Dont forget to dim the variables etc.

Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim strPath As String
Dim FileName as String
Dim x As Long