Function FilenamesCollection ByVal FolderPath As String Optional ByVal

Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", Optional ByVal SearchDeep As Long = 999) As Collection
    
    ' ïîëó÷àåò â êà÷åñòâå ïàðàìåòðà ïóòü ê ïàïêå FolderPath,
    ' ìàñêó èìåíè èñêîìûõ ôàéëîâ Mask (áóäóò îòîáðàíû òîëüêî ôàéëû ñ òàêîé ìàñêîé/ðàçðåøåíèåì)
    ' è ãëóáèíó ïîèñêà SearchDeep â ïîäïàïêàõ (åñëè SearchDeep = 1, òî ïîäïàïêè íå ïðîñìàòðèâàþòñÿ)
    ' âîçâðàùàåò êîëëåêöèþ, ñîäåðæàùóþ ïîëíûå ïóòè íàéäåíûõ ôàéëîâ
    ' ïðèìåíÿåòñÿ ðåêóðñèâíûé âûçîâ ïðîöåäóðû GetAllFileNamesUsingFSO
    Set FilenamesCollection = New Collection
    Set FSO = CreateObject("Scripting.FileSystemObject")
    GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep
    Set FSO = Nothing: Application.StatusBar = False
    
End Function
Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)

    ' ïåðåáèðàåò âñå ôàéëû è ïîäïàïêè â ïàïêå FolderPath, èñïîëüçóÿ îáúåêò FSO
    ' ïåðåáîð ïàïîê îñóùåñòâëÿåòñÿ â òîì ñëó÷àå, åñëè SearchDeep > 1
    ' äîáàâëÿåò ïóòè íàéäåííûõ ôàéëîâ â êîëëåêöèþ FileNamesColl
    On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
    If Not curfold Is Nothing Then
        For Each fil In curfold.Files ' ïåðåáèðàåì âñå ôàéëû â ïàïêå FolderPath
           If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.path
        Next
        SearchDeep = SearchDeep - 1 ' óìåíüøàåì ãëóáèíó ïîèñêà â ïîäïàïêàõ
        If SearchDeep Then ' åñëè íàäî èñêàòü ãëóáæå
        For Each sfol In curfold.SubFolders ' ïåðåáèðàåì âñå ïîäïàïêè â ïàïêå FolderPath
            GetAllFileNamesUsingFSO sfol.path, Mask, FSO, FileNamesColl, SearchDeep
            Next
        End If
        Set fil = Nothing: Set curfold = Nothing ' î÷èùàåì ïåðåìåííûå
    End If
    
End Function
Function ReadClient()
    
    ' çàïèñûâàåò êîëëåêöèþ êíèã ñ äàííûìè î êëèåíòàõ
    Application.DisplayAlerts = False
    On Error Resume Next
    new_path = "C:\Users\evgeny\Desktop\ÈÄÇ ¹3\Çàíÿòèå 6 äëÿ ñòóäåíòîâ\Ïðîäàæè.Êëèåíòû\" ' ñîçäà¸ì äèðåêòîðèþ, â êîòîðîé áóäåì õðàíèòü êíèãè ñ îò÷¸òàìè î ïîêóïêàõ âñåõ êëèåíòîâ
    
    ' åñëè äàííàÿ äèðåêòîðèÿ ñóùåñòâóåò, òî èñêëþ÷àåì ïåðåçàïèñü
    If Dir(new_path, vbDirectory) = "" Then
        MkDir (new_path) ' ñîçäà¸ì äèðåêòîðèþ "Ïðîäàæè.Êëèåíòû" ïî óêàçàííîìó ïóòè
        
        folder = "C:\Users\evgeny\Desktop\ÈÄÇ ¹3\Çàíÿòèå 6 äëÿ ñòóäåíòîâ\Ïðîäàæè\"
        general_path = ThisWorkbook.path
        Set general_WB = Application.Workbooks.Add ' âñïîìîãàòåëüíàÿ êíèãà äëÿ ïàðñèíãà êëèåíòîâ
        
        ' ïðîâåðêà íà ñóùåñòâîâàíèå äèðåêòîðèè
        If Dir(folder, vbDirectory) = "" Then
            MsgBox ("Äàííàÿ äèðåêòîðèÿ íå íàéäåíà")
            Exit Function
        End If
        
        ' ñîçäà¸ì êîëëåêöèþ êíèã òåêóùåé äèðåêòîðèè
        Set coll = FilenamesCollection(folder, "*.xls")
        
        ' ïðîâåðêà íà ïóñòîòó êîëëåêöèè
        If coll.Count = 0 Then
            MsgBox ("Äàííàÿ äèðåêòîðèÿ ïóñòà")
        End If
        
        ' ïåðåáèðàåì êîëëåêöèþ è çàïèñûâàåì ïîëó÷åííûå îò÷¸íû â íîâóþ äèðåêòîðèþ
        For i = 1 To 3
            ' ïàðñèíã êëèåíòà
            Workbooks.Open coll.Item(i)
            Set cur_WB = ActiveWorkbook
            general_WB.Sheets(1).Cells(i + 1, 1) = cur_WB.Sheets(1).Cells(2, 2)
            general_WB.Sheets(1).Cells(i + 1, 2).FormulaR1C1 = "=TRIM(MID(RC[-1],FIND(""Êëèåíò:"",RC[-1]) + 8,LEN(RC[-1]) + 6))"
            clients_name = general_WB.Sheets(1).Cells(i + 1, 2).Value
            cur_name = clients_name & ".xls"
            
            ' åñëè êëèåíò ïîâòîðÿåòñÿ, òî äîáàâëÿì äàííûå â ðàíåå ñîçäàííóþ äëÿ íåãî êíèãó
            rep_name = Dir(new_path, vbDirectory)
            Do While rep_name <> ""
                If rep_name <> "." And rep_name <> ".." Then
                    If rep_name Like "*.xls" And cur_name = rep_name Then
                        Workbooks.Open new_path & rep_name
                        Set cur2_WB = ActiveWorkbook
                        cur_row = cur_WB.Sheets(1).Cells(1, 1).CurrentRegion.Rows.Count + 1
                        work_row = cur_WB2.Sheets(1).Cells(1, 1).CurrentRegion.Rows.Count - 2
                        y = 3
                        For j = cur_row To work_row + cur_row
                            For k = 1 To 4
                                cur_WB.Sheets(1).Cells(j, k) = cur_WB2.Sheets(1).Cells(y, k)
                            Next
                            y = y + 1
                        Next
                        cur_WB2.Close
                    End If
                End If
                rep_name = Dir
            Loop

            cur_WB.SaveAs (new_path & clients_name)
            cur_WB.Close
        Next
        Exit Function
    End If
  
End Function

Function AddClientsToListBox()
    first_path = "C:\Users\evgeny\Desktop\ÈÄÇ ¹3\Çàíÿòèå 6 äëÿ ñòóäåíòîâ\Ïðîäàæè2\"
    Myname = Dir(first_path, vbDirectory)
    Do While Myname <> ""
        If Myname <> "." And Myname <> ".." Then
            If Myname Like "*.xls" Then
                UserForm1.ListBox1.AddItem ((Replace(Myname, ".xls", "")))
            End If
        End If
        Myname = Dir
    Loop
End Function
Sub GetReportAboutClient()
    first_path = "C:\Users\evgeny\Desktop\ÈÄÇ ¹3\Çàíÿòèå 6 äëÿ ñòóäåíòîâ\Ïðîäàæè2\"
    cur_name = UserForm1.ListBox1.Text & ".xls"
    Myname = Dir(first_path, vbDirectory)
    Do While Myname <> ""
        If Myname <> "." And Myname <> ".." Then
            If Myname Like "*.xls" And Myname = cur_name Then
                Workbooks.Open first_path & Myname
            End If
        End If
        Myname = Dir
    Loop
End Sub