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
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,505
Messages
5,832,128
Members
430,111
Latest member
Francis Xavier

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top