Naming a file based on another file in a directory

[jsolomon]

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

 

[Von Pookie]

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.

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]

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

 

[jsolomon]

Why is it that this code only goes up to 31 files?

 

[Von Pookie]

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

Change it to

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.

 

[mdusoe]

Maybe a try this?

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]

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]

Admittedly, I haven't tried that code, but I would suggest you try changing this

MaxNumber = x

to

MaxNumber = x + 1

 

[Norie]

Try this, adapted from Von Pookie's code.

I tested it up to 61, then got bored.

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]

I figured it out. i had to add a 1 to the variables. thanks again for the help