extracting number from foldername

[Arie Bos]

I have a main folder ('...\Sales\PO') with a series of project folders, named 2023.001 - xxxx, 2023.002 - yyyy, 2023.003 - zzzz and so forth.
I want to place the last number found + 1 in a cell, so that should be 2023.004.
the following code is working well, but it returns 2023.3004. I can't find why this is though.

Sub CreateNewProjectNumber()

    Dim fso As Object
    Dim folder As Object
    Dim folderName As String
    Dim folderNumber As Double
    Dim maxNumber As Double
    Dim folderPath As String
    Dim currentYear As Integer
    
    ' Get the current year
    currentYear = Year(Date)
    
    ' Set the folder path where the folders are located
    folderPath = Environ("userprofile") & "\OneDrive - ADAR Technologies, LLC\SharePoint\Sales\PO\"
    
    ' Create a FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Loop through the folders in the specified directory
    For Each folder In fso.GetFolder(folderPath).SubFolders
        ' Check if the folder name matches the pattern
        If folder.Name Like currentYear & ".* - *" Then
            ' Extract the folder number from the folder name
            folderNumber = CDbl(Mid(folder.Name, Len(currentYear) + 2, InStr(folder.Name, " ") - Len(currentYear) - 2))
            
            ' Update the maximum number if the current number is larger
            If folderNumber > maxNumber Then
                maxNumber = folderNumber
            End If
        End If
    Next folder
    
    ' Add 1 to the maximum number
    maxNumber = maxNumber + 1
    
    ' Determine the number of leading zeros needed
    Dim leadingZeros As String
    leadingZeros = IIf(maxNumber < 10, "00", IIf(maxNumber < 100, "0", ""))
    
    ' Assign the result to the 'Project.Num' cell as a string
    Worksheets("Quotation").Range("Project.Num").NumberFormat = "@"
    Worksheets("Quotation").Range("Project.Num").Value = currentYear & "." & leadingZeros & maxNumber
    Worksheets("Quotation").Range("Project.Num").NumberFormat = "0000\.000"
    
End Sub

 

[Georgiboy]

Perhaps you could try it as below, I have had a go at simplifying the below line:

folderNumber = CDbl(Mid(folder.Name, Len(currentYear) + 2, InStr(folder.Name, " ") - Len(currentYear) - 2))

Sub CreateNewProjectNumber()

    Dim fso As Object
    Dim folder As Object
    Dim folderName As String
    Dim folderNumber As Double
    Dim maxNumber As Double
    Dim folderPath As String
    Dim currentYear As Integer
    
    ' Get the current year
    currentYear = Year(Date)
    
    ' Set the folder path where the folders are located
    folderPath = Environ("userprofile") & "\OneDrive - ADAR Technologies, LLC\SharePoint\Sales\PO\"
    
    ' Create a FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Loop through the folders in the specified directory
    For Each folder In fso.GetFolder(folderPath).SubFolders
        ' Check if the folder name matches the pattern
        If Left(folder.Name, 4) = currentYear Then
            ' Extract the folder number from the folder name
            folderNumber = Split(folder.Name, ".")(1)
            
            ' Update the maximum number if the current number is larger
            If folderNumber > maxNumber Then
                maxNumber = folderNumber
            End If
        End If
    Next folder
    
    ' Add 1 to the maximum number
    maxNumber = maxNumber + 1
    
    ' Determine the number of leading zeros needed
    Dim leadingZeros As String
    leadingZeros = IIf(maxNumber < 10, "00", IIf(maxNumber < 100, "0", ""))
    
    ' Assign the result to the 'Project.Num' cell as a string
    With Worksheets("Quotation").Range("Project.Num")
        .NumberFormat = "@"
        .Value = currentYear & "." & leadingZeros & maxNumber
        .NumberFormat = "0000\.000"
    End With
End Sub

 

[Georgiboy]

You could probably also trim it down a bit:

Sub CreateNewProjectNumber()
    Dim fso As Object, folder As Object, folderNumber As Double, folderPath As String
    
    folderPath = Environ("userprofile") & "\OneDrive - ADAR Technologies, LLC\SharePoint\Sales\PO\"
    Set fso = CreateObject("Scripting.FileSystemObject")

    For Each folder In fso.GetFolder(folderPath).SubFolders
        If Left(folder.Name, 4) = Year(Date) Then
            folderNumber = Split(folder.Name, ".")(1)
        End If
    Next folder
    With Worksheets("Quotation").Range("Project.Num")
        .NumberFormat = "@"
        .Value = currentYear & "." & Format(folderNumber + 1, "000")
    End With
End Sub

 

[Arie Bos]

I got it solved...

 

[Joe4]

I got it solved...

Please post the solution. Then others can see what you did and you can mark that post as the solution.

 

[Arie Bos]

Thank you GeorgiBoy,
Your first code gave an error, and i replaced 1 line to : 'folderNumber = Left(Mid(folder.Name, 7), 3)' then it returned 2023.047 (following last folder 046).
The shorter code returned '0.001', so that did not work.
thanks again,
Arie

 

[Arie Bos]

Sure Joe4, I was still busy with it
this is the code that works good:

Sub CreateNewProjectNumber()

    Dim fso As Object
    Dim folder As Object
    Dim folderName As String
    Dim folderNumber As String ' change the data type to string
    Dim maxNumber As Double
    Dim folderPath As String
    Dim currentYear As Integer
    
    ' Get the current year
    currentYear = Year(Date)
    
    ' Set the folder path where the folders are located
    folderPath = Environ("userprofile") & "\OneDrive - ADAR Technologies, LLC\SharePoint\Sales\PO\"
    
    ' Create a FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Loop through the folders in the specified directory
    For Each folder In fso.GetFolder(folderPath).SubFolders
        ' Check if the folder name matches the pattern
        If folder.Name Like currentYear & ".* - *" Then
            ' Extract the folder number from the folder name
            folderNumber = Left(Mid(folder.Name, 7), 3) ' extract 3 characters starting from the 7th position
            ' Update the maximum number if the current number is larger
            If CDbl(folderNumber) > maxNumber Then ' convert the string to double only for comparison
                maxNumber = CDbl(folderNumber)
            End If
        End If
    Next folder
    Debug.Print "21. folderNumber = " & folderNumber

    ' Add 1 to the maximum number
    maxNumber = maxNumber + 1
    Debug.Print "22. maxNumber = " & maxNumber
    
    ' Determine the number of leading zeros needed
    Dim leadingZeros As String
    leadingZeros = IIf(maxNumber < 10, "00", IIf(maxNumber < 100, "0", ""))
    Debug.Print "23. leadingZeros = " & leadingZeros; ""

    ' Assign the result to the 'Project.Num' cell as a string
    With Worksheets("Quotation").Range("Project.Num")
        .NumberFormat = "@"
        .Value = currentYear & "." & leadingZeros & maxNumber
        .NumberFormat = "0000\.000"
    End With
    
End Sub