Move files based on specific words location in new folders

[jindon]

Replace "test" & "SearchFiles" procedures with below

Sub test()
    Dim myDir$, x, myList(), i&, msg$, FileList
    FileList = Array("APPVD", "CCVB", "SSSSVB")
    myDir = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\ABSI"
    x = SearchFiles(myDir, "* *.*", 0, myList, myDir, FileList)
    If IsEmpty(x) Then MsgBox "No file found": Exit Sub
    For i = 1 To UBound(x, 2)
        If myList(1, i) <> myList(2, i) Then
            If Not IsFileOpen(x(1, i)) Then
                Call CheckFolder(x(2, i))
                Name x(1, i) As x(2, i)
            Else
                msg = msg & vbLf & x(1, i)
            End If
        End If
    Next
    If Len(msg) Then MsgBox "Follwing file(s) is/are currently in use", vbInformation, "Try later"
End Sub


Function SearchFiles(fPath$, myFileName$, n&, myList(), myDir, FileList) As Variant
    Dim e, fso As Object, myFolder As Object, myFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each myFile In fso.GetFolder(fPath).Files
        If (Not myFile.Name Like "~$*") * (myFile.Name <> ThisWorkbook.Name) _
        * (myFile.Name Like myFileName) Then
            If IsNumeric(Application.Match(Split(fso.GetBaseName(myFile.Name))(0), FileList, 0)) Then
                n = n + 1
                ReDim Preserve myList(1 To 2, 1 To n)
                myList(1, n) = myFile.Path
                myList(2, n) = Join(Array(myDir, "YEAR_" & Year(myFile.DateLastModified), _
                    Split(fso.GetBaseName(myFile.Name))(0), "EXTRACTION_" & _
                    Choose(Month(myFile.DateLastModified), _
                    "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", _
                    "DEC"), myFile.Name), "\")
            End If
        End If
    Next
    For Each myFolder In fso.GetFolder(fPath).SubFolders
        SearchFiles = SearchFiles(myFolder.Path, myFileName, n, myList, myDir, FileList)
    Next
    SearchFiles = myList
End Function

[Mussa]

works greatly !
much appreciated for your time & help jindon.