Adding a counter to a filename

soteman2005

New Member
Joined
Nov 24, 2005
Messages
32
Hi,
I have this code to copy several worksheets and then save them in a new workbook in the same directory. This works but I have also tried to add a unique number on the end of the filename, so the script looks to see if the filename exists and if it does, it adds one. But at the moment, it tries to save with _01 everytime..

any idea???

thanks


Code:
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim strPath As String
Dim filename As String
Dim x As Long
Dim dir As String

    Application.ScreenUpdating = False
    
    filename = "\Test" & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & "_01"

    dir = ActiveWorkbook.Path
   Sheets(Array("A", "B", "C")).Copy
    
    If fso.FileExists(filename) = True Then
                For x = 2 To 50
            filename = Left(filename, Len(filename) - 1) & Right("00" & x, 2)
            If fso.FileExists(filename) = False Then
        ActiveWorkbook.SaveAs filename:=dir & filename
                Exit For
            End If
        Next
    Else
        ActiveWorkbook.SaveAs filename:=dir & filename
    
    Application.ScreenUpdating = True
      End If
 

Some videos you may like

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
If you put:

MsgBox filename & " exists " & fso.FileExists(filename)

before your If tests, does it tell you what you expect?
 

soteman2005

New Member
Joined
Nov 24, 2005
Messages
32
It returns false even though the next thing it tells me is that the file exists and do I want to overwrite it. Which is quite confusing....
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Looking at your code again, it seems you need eg:

If fso.FileExists(dir & filename) = True Then
 

pfarmer

Well-known Member
Joined
Jul 6, 2005
Messages
550
soteman2005 said:
Hi,
I have this code to copy several worksheets and then save them in a new workbook in the same directory. This works but I have also tried to add a unique number on the end of the filename, so the script looks to see if the filename exists and if it does, it adds one. But at the moment, it tries to save with _01 everytime..

any idea???

thanks


Code:
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim strPath As String
Dim filename As String
Dim x As Long
Dim dir As String

    Application.ScreenUpdating = False
    
    filename = "\Test" & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & "_01"

    dir = ActiveWorkbook.Path
   Sheets(Array("A", "B", "C")).Copy
    
    If fso.FileExists(filename) = True Then
                For x = 2 To 50
            filename = Left(filename, Len(filename) - 1) & Right("00" & x, 2)
            If fso.FileExists(filename) = False Then
        ActiveWorkbook.SaveAs filename:=dir & filename
                Exit For
            End If
        Next
    Else
        ActiveWorkbook.SaveAs filename:=dir & filename
    
    Application.ScreenUpdating = True
      End If

This creates a file named Number.txt in C:\test\number\. The file increments by 1 each time this routine is run and resets to 0 if Number.txt is deleted.


Code:
Public Function NextSeqNumber(Optional sFileName As String, Optional nSeqNumber As Long = -1) As Long
        Const sDEFAULT_PATH As String = "C:\Test\Work Permit Logs\PermitForm\Number\"
        Const sDEFAULT_FNAME As String = "Number.txt"
             
        
        Dim nFileNumber As Long

        nFileNumber = FreeFile

        If sFileName = "" Then sFileName = sDEFAULT_FNAME
                
        If InStr(sFileName, Application.PathSeparator) = 0 Then _
            sFileName = sDEFAULT_PATH & Application.PathSeparator & sFileName
        If nSeqNumber = -1& Then
            If Dir(sFileName) <> "" Then
                Open sFileName For Input As nFileNumber
                Input #nFileNumber, nSeqNumber
                nSeqNumber = nSeqNumber + 1&
                Close nFileNumber
            Else
                nSeqNumber = 1&
            End If
        End If
        On Error GoTo GeneralError
        Open sFileName For Output As nFileNumber
        On Error GoTo 0
        Print #nFileNumber, nSeqNumber
        Close nFileNumber
        NextSeqNumber = nSeqNumber
        Exit Function
GeneralError:
        NextSeqNumber = -1&
    End Function

Perry
 

Watch MrExcel Video

Forum statistics

Threads
1,119,144
Messages
5,576,336
Members
412,718
Latest member
dragosm
Top