Private Sub test2()
'AK003.txt format
Dim fso As Object, FolDir As Object, FileNm As Object, NumStr As Integer, MaxNum As Integer
Dim NewName As String, FolderStr As String, StrNum As String, MaxStr As String
MaxNum = 1
FolderStr = "C:\YourFolderName\"
Set fso = CreateObject("scripting.filesystemobject")
Set FolDir = fso.GetFolder(FolderStr)
For Each FileNm In FolDir.Files
If FileNm.Name Like "AK" & "*" & ".txt" Then
StrNum = Right(Left(FileNm.Name, 5), 3)
NumStr = CInt(StrNum)
If NumStr > MaxNum Then
MaxNum = NumStr
End If
End If
Next FileNm
MaxStr = CStr(Format(MaxNum + 1, "000"))
NewName = FolderStr & "AK" & MaxStr & ".txt"
'file format????
ActiveWorkbook.SaveAs Filename:=NewName, FileFormat:=xlText, CreateBackup:=False
Set FolDir = Nothing
Set fso = Nothing
End Sub
This seems to work. U will have to change the folder path. I'm not sure about the saveas line of code and this might require change. HTH. Dave
Code:Private Sub test2() 'AK003.txt format Dim fso As Object, FolDir As Object, FileNm As Object, NumStr As Integer, MaxNum As Integer Dim NewName As String, FolderStr As String, StrNum As String, MaxStr As String MaxNum = 1 FolderStr = "C:\YourFolderName\" Set fso = CreateObject("scripting.filesystemobject") Set FolDir = fso.GetFolder(FolderStr) For Each FileNm In FolDir.Files If FileNm.Name Like "AK" & "*" & ".txt" Then StrNum = Right(Left(FileNm.Name, 5), 3) NumStr = CInt(StrNum) If NumStr > MaxNum Then MaxNum = NumStr End If End If Next FileNm MaxStr = CStr(Format(MaxNum + 1, "000")) NewName = FolderStr & "AK" & MaxStr & ".txt" 'file format???? ActiveWorkbook.SaveAs Filename:=NewName, FileFormat:=xlText, CreateBackup:=False Set FolDir = Nothing Set fso = Nothing End Sub
Private Sub test()
'AK003.txt format
Dim fso As Object, FolDir As String, FileNm As Object, NumStr As Integer, MaxNum As Integer
Dim NewName As String, StrNum As String, MaxStr As String
Dim FolderStr As String 'Object
MaxNum = 1
FolderStr = "C:\YourFolderName\"
'Set fso = CreateObject("scripting.filesystemobject")
'Set FolDir = fso.GetFolder(FolderStr)
FolDir = Dir(FolderStr)
'For Each FileNm In FolDir.Files
Do While Len(FolDir) > 0
'If FileNm.Name Like "AK" & "*" & ".txt" Then
If FolDir Like "AK" & "*" & ".txt" Then
StrNum = Right(Left(FolDir, 5), 3)
NumStr = CInt(StrNum)
If NumStr > MaxNum Then
MaxNum = NumStr
End If
End If
FolDir = Dir
'Next FileNm
Loop
MaxStr = CStr(Format(MaxNum + 1, "000"))
NewName = FolderStr & "AK" & MaxStr & ".txt"
'file format????
ActiveWorkbook.SaveAs Filename:=NewName, FileFormat:=xlText, CreateBackup:=False
'Set FolDir = Nothing
'Set fso = Nothing
End Sub