Djblois
12-01-2023, 09:33 AM
I have this code that loops through a folder and adds all the subfolders in a combobox. It works but it is very slow because there are 100s of subfolders. They all named after the date they were uploaded. eg. 20230105. I don't need all the folders. Only the last like 2 or 3 years. If maybe it is possible to only get only the most recent. Is there any way to speed this up?
Private Sub cmdGetSubfolder_Click()
Dim fsoFile As FileSystemObject: Set fsoFile = New FileSystemObject
Dim fldFile As Object: Set fldFile = fsoFile.GetFolder(Me.tbPath)
Dim fldCount As Integer: fldCount = 0
On Error GoTo sub_error
Application.ScreenUpdating = False
Dim subFolder As Object: For Each subFolder In fldFile.SubFolders
If CLng(Left(subFolder.Name, 4)) > Year(Date) - 2 Then
fldCount = fldCount + 1
Me.cobFolderDate.AddItem subFolder.Name
End If
Next subFolder
Set fsoFile = Nothing
Set fldFile = Nothing
Application.ScreenUpdating = True
Exit Sub
sub_error:
MsgBox "There is an issue with the path"
Exit Sub
End Sub
Private Sub cmdGetSubfolder_Click()
Dim fsoFile As FileSystemObject: Set fsoFile = New FileSystemObject
Dim fldFile As Object: Set fldFile = fsoFile.GetFolder(Me.tbPath)
Dim fldCount As Integer: fldCount = 0
On Error GoTo sub_error
Application.ScreenUpdating = False
Dim subFolder As Object: For Each subFolder In fldFile.SubFolders
If CLng(Left(subFolder.Name, 4)) > Year(Date) - 2 Then
fldCount = fldCount + 1
Me.cobFolderDate.AddItem subFolder.Name
End If
Next subFolder
Set fsoFile = Nothing
Set fldFile = Nothing
Application.ScreenUpdating = True
Exit Sub
sub_error:
MsgBox "There is an issue with the path"
Exit Sub
End Sub