Microsoft Office Forums - View Single Post

nmkhan3010 · 04-18-2020, 10:32 PM

Thanks for your prompt response....
Am gaining more productivity with your help....

Currently am doing the same practices but somewhere it is missing and copying wrong files into the folder and again re-checking where it has been missed taking more time and that this is happened due to more no. of files in folder (200+ files) and it is difficult to handle at a time. So am trying for the perfection in this …..

Am having the below code, can you modify according to my need....

Thanks in advance….

Code:

Sub FolderizeFiles()

    Dim fso As Object, fldr As Object, subFldr As Object, fle As Object
    Dim fldrNew As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldr = fso.GetFolder("C:\Users\xuza\test")
        
    For Each fle In fldr.Files
        If Right(fso.GetBaseName(fle), 14) = "-EnglishTables" Then
            fldrNew = fldr.Path & "\" & fso.GetBaseName(fle)
        
            If Not fso.FolderExists(fldrNew) Then
                fso.CreateFolder fldrNew
            End If
            
            fso.MoveFile _
                Source:=fle.Path, _
                Destination:=fldrNew & "\" & fle.Name
        End If
    Next fle
    
    For Each fle In fldr.Files
        For Each subFldr In fldr.SubFolders
            If Left(subFldr.Name, 8) = Left(fle.Name, 8) Then
                fso.MoveFile _
                    Source:=fle.Path, _
                    Destination:=subFldr.Path & "\" & fle.Name
                Exit For
            End If
        Next subFldr
    Next fle

End Sub