Naming a file based on another file in a directory

jsolomon

Board Regular
Joined
Mar 25, 2005
Messages
109
Hi,
What I am trying to do is make excel look for a file in a directory. In the said directory are other numbered files (ex 1.xls, 2.xls, 3.xls, 4.xls etc.). I want Excel to find the largest numbered file (in the ex, it would be 4.xls) and save the file as the last numbered file plus 1 (so in the ex it would save the file as 5.xls). I'm not sure if you can do that in VB or not.

Thanks

Joe
 

Some videos you may like

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Von Pookie

MrExcel MVP
Joined
Feb 17, 2002
Messages
13,686
This seems to work for me (and I managed to learn something new today while looking up a way to get it to work :) ) Note: This should work on filenames that are numbers *only.* (such as 1.xls, 2.xls, etc.). I haven't tested this on filenames such as test1.xls, test2.xls, etc.

Code:
Sub test()
Dim myDir As String, Bk As String, ArrBk As String
Dim i As Long, x As Integer, FileNum As Long

'directory that will be searched
myDir = "C:\test\"

'search specified directory for all .xls files
With Application.FileSearch
    .NewSearch
    .LookIn = myDir
    .SearchSubFolders = False
    .Filename = "*.xls"
    .MatchTextExactly = True
    .FileType = msoFileTypeAllFiles
    
    If .Execute() > 0 Then
        'loop through all .xls files found in folder
        For i = 1 To .FoundFiles.Count
            'set full filepath of found .xls file as variable
            Bk = .FoundFiles(i)
            
            'grabs filename (minus .xls extension) from full filepath
            x = Len(Bk) - Len(Application.Substitute(Bk, "\", ""))
            x = Application.Find("~", Application.Substitute(Bk, "\", "~", x)) + 1
            Bk = Mid(Bk, x, Len(Bk))
            Bk = Mid(Bk, 1, Len(Bk) - 4)
            
            'saves all filenames to variable as string, separated by commas
            If ArrBk = Empty Then
                ArrBk = Bk
            Else
                ArrBk = ArrBk & "," & Bk
            End If
        Next i
        
        'determines largest number from string, adds 1
        FileNum = Application.Evaluate("=MAX(" & ArrBk & ")") + 1
        
        'saves file with new number for name
        ActiveWorkbook.SaveAs Filename:=myDir & FileNum & ".xls"
    Else
        MsgBox "No Excel files found in " & myDir
    End If
End With

End Sub
 

jsolomon

Board Regular
Joined
Mar 25, 2005
Messages
109
wow, that is some pretty complex code. I'm still novice at VBA, but I think I'm starting to get the hang of it. Thank you so much for your help :)

Joe
 

Von Pookie

MrExcel MVP
Joined
Feb 17, 2002
Messages
13,686

ADVERTISEMENT

No idea. I didn't try it with that many files.

Hmm. It's stopping on the Application.Evaluate line...Oh, ok.

The MAX worksheet function can only accept 30 arguments (in this case, the numbers 1-30). To be honest, I thought I had set it to calculate it as an array--I now see that I forgot the brackets in the formula :rolleyes: :oops:

Change it to
Code:
FileNum = Application.Evaluate("=MAX({" & ArrBk & "})") + 1

I think other than that, you'll more than likely be limited on how many items can be in the array. After adding the brackets to the formula, I made it up to 86 files before I ran into the error again.

I'm not sure how to get around that, though. :confused:
 

mdusoe

Active Member
Joined
Aug 27, 2004
Messages
428
Maybe a try this?

Code:
Sub LargestFile()
    Dim x As Integer
    Dim MaxNumber As Integer
    Dim MyPath As String
    Dim FName As String
    
    MyPath = "C:\Temp\"
    
    FName = Dir(MyPath & "*.xls")
    Do Until FName = ""
        On Error Resume Next
        x = CInt(Replace(FName, ".xls", ""))
        If Err.Number = 0 Then
            If x > MaxNumber Then
                MaxNumber = x
            End If
        End If
        FName = Dir()
    Loop
    
    ActiveWorkbook.SaveAs Filename:=MyPath & MaxNumber & ".xls"
End Sub

It is a little bit simpler (without an array to maintain), plus it has the added benefit of not having any limitations on the number of files.

HTH,
Mike.
 

jsolomon

Board Regular
Joined
Mar 25, 2005
Messages
109

ADVERTISEMENT

Thanks, the only malfunction in that is when you run it, it is not increasing hte number after every save. So if I were up to 10.xls, and I ran the macro, it would try to save it as 10.xls instead of 11.xls. How can i make the code work?

Thanks again

Joe
 

Von Pookie

MrExcel MVP
Joined
Feb 17, 2002
Messages
13,686
Admittedly, I haven't tried that code, but I would suggest you try changing this
Code:
MaxNumber = x

to
Code:
MaxNumber = x + 1
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,062
Office Version
  1. 365
Platform
  1. Windows
Try this, adapted from Von Pookie's code.

I tested it up to 61, then got bored.
Code:
Sub test()
Dim myDir As String, Bk As String, ArrBk As String
Dim i As Long, x As Integer, FileNum As Long

'directory that will be searched
myDir = "C:\test\"

'search specified directory for all .xls files
With Application.FileSearch
    .NewSearch
    .LookIn = myDir
    .SearchSubFolders = False
    .Filename = "*.xls"
    .MatchTextExactly = True
    .FileType = msoFileTypeAllFiles
    
    If .Execute() > 0 Then
        'loop through all .xls files found in folder
        For i = 1 To .FoundFiles.Count
            'set full filepath of found .xls file as variable
            Bk = .FoundFiles(i)
            
            Bk = Mid(Bk, InStrRev(Bk, "\") + 1)
            Bk = Left(Bk, Len(Bk) - 4)
            If Val(Bk) > FileNum Then
                FileNum = Val(Bk)
            End If
        Next i
          
        ActiveWorkbook.SaveAs Filename:=myDir & FileNum + 1 & ".xls"
    Else
        MsgBox "No Excel files found in " & myDir
    End If
End With

End Sub
 

jsolomon

Board Regular
Joined
Mar 25, 2005
Messages
109
I figured it out. i had to add a 1 to the variables. thanks again for the help :)
 

Watch MrExcel Video

Forum statistics

Threads
1,118,910
Messages
5,574,994
Members
412,633
Latest member
simon_elvin
Top