Adding a counter to a filename

[soteman2005]

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

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

 

[Andrew Poulsom]

If you put:

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

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

 

[soteman2005]

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]

Looking at your code again, it seems you need eg:

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

 

[pfarmer]

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

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.

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