Saving Workbook As Name with Date and Unique Number

soteman2005

New Member
Joined
Nov 24, 2005
Messages
32
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


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

Some videos you may like

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

bandit_1981

Board Regular
Joined
Aug 17, 2005
Messages
201
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

New Member
Joined
Nov 24, 2005
Messages
32
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

Board Regular
Joined
Aug 17, 2005
Messages
201
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.



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

New Member
Joined
Nov 24, 2005
Messages
32

ADVERTISEMENT

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

Board Regular
Joined
Aug 17, 2005
Messages
201
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

New Member
Joined
Nov 24, 2005
Messages
32
This produces an object not found error?

Code:
If fso.FileExists(FileName) = True Then
[/code]
 

bandit_1981

Board Regular
Joined
Aug 17, 2005
Messages
201
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
 

Watch MrExcel Video

Forum statistics

Threads
1,118,818
Messages
5,574,501
Members
412,599
Latest member
Schu94
Top