Вопрос по файловой системе в VBA

Sub Primer ()
r = 0
' Получение имени первого файла
f = Dir ('С:Work ')
' ввожу имя своей папки  
Do while f <> ''
r = r + 1
Cells (r, 1) = f
' Получение имени следующего файла
f = Dir
Loop
End Sub

Function ИмяФайлаБезРасширения1(FileName)
  Do While Len(FileName) > 1
    If Right(FileName, 1) <> '.' Then
      FileName = Left(FileName, Len(FileName) - 1)
    Else
      FileName = Left(FileName, Len(FileName) - 1)
      Exit Do
    End If
  Loop
  ИмяФайлаБезРасширения1 = FileName
End Function
 
Function ИмяФайлаБезРасширения2(FileName)
  t = Split(FileName, '.')
  If IsArray(t) Then ИмяФайлаБезРасширения2 = Left(FileName, Len(FileName) - Len(t(UBound(t))) - 1)
End Function

Sub ПолучитьСписокФайловВпапке(sPath, ByRef msFile())
  Dim fs, f, f1, fc, s
  ReDim Preserve msFile(0)
  Set fs = CreateObject('Scripting.FileSystemObject')
  Set f = fs.GetFolder(sPath)
  'Set fc = f.SubFolders        'для ПАПОК
  Set fc = f.Files              'для ФАЙЛОВ
  For Each f1 In fc
    ReDim Preserve msFile(UBound(msFile) + 1)
    msFile(UBound(msFile)) = f1.Name
  Next
End Sub
 
Sub пример()
  Dim msFile()
  Call ПолучитьСписокФайловВпапке('C:Temp', msFile())
  mes = ''
  For i = 1 To UBound(msFile)
    mes = mes & msFile(i) & vbCr
  Next
  MsgBox mes
End Sub

Private Sub CommandButton1_Click() 'поиск файлов в указанной директории
' и вывод их в книгу excel
Dim fs, i, a
Worksheets("лист1").Activate
 
Set fs = Application.FileSearch
With fs
.LookIn = "c:   emp"
.SearchSubFolders = True
.Filename = "*.*"  'можно написать *.htm, он отберет только их
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
Cells(i + 5, 2).Value = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

Private Function GetSubFolders(ByVal pstrFolder As String, _
                               ByVal pblnGetNestingSubfolders As Boolean) As String
    
    Dim objFSO As New FileSystemObject
    Dim objFolder As Folder
    Dim objSubFolder As Object
 
    Set objFolder = objFSO.GetFolder(pstrFolder)
    
    For Each objSubFolder In objFolder.SubFolders
        MsgBox objSubFolder.Name
        If pblnGetNestingSubfolders Then
            GetSubFolders objSubFolder.Path, pblnGetNestingSubfolders
        End If
    Next objSubFolder
    
End Function

Sub Пример()
Dim msFile()
Dim fs, f, f1, fc, s
SubFolders = True
ReDim Preserve msFile(0)
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:Temp")
Set fc = f.SubFolders 
For Each f1 In fc
ReDim Preserve msFile(UBound(msFile) + 1)
msFile(UBound(msFile)) = "C:Temp" & f1.Name
Open "C:Temp" For Append As #1
Print #1, f1.Name
Close #1
Set fs2 = CreateObject("Scripting.FileSystemObject")
Set f2 = fs2.GetFolder(f1)
Set fc2 = f2.SubFolders 
For Each f3 In fc2
ReDim Preserve msFile(UBound(msFile) + 1)
msFile(UBound(msFile)) = f3.Name
Open " C:Temp " For Append As #1
Print #1, "C:Temp" & f1.Name & "" & f3.Name
Close #1
Next
Next
mes = ""
For i = 1 To UBound(msFile)
mes = mes & msFile(i) & vbCr
Next
End Sub

Private Sub Command1_Click()
     Dim strRoot As String
     
     strRoot = "C:Documents and Settings...My Documents"
     mintInitialIndent = UBound(Split(strRoot, ""))
     RichTextBox1.Text = ""
     GetSubFolders "C:Documents and Settings...My Documents", True, mintInitialIndent
 
End Sub
 
Private Function GetSubFolders(ByVal pstrFolder As String, _
                               ByVal pblnGetNestingSubfolders As Boolean, _
                               ByVal pintLevel As Integer) As String
                                
    Dim objFSO As New FileSystemObject
    Dim objFolder As Folder
    Dim objSubFolder As Object
    Dim strReturn As String
       
    Set objFolder = objFSO.GetFolder(pstrFolder)
    
    For Each objSubFolder In objFolder.SubFolders
        DoEvents
        
        If RichTextBox1.Text = "" Then
            RichTextBox1.Text = objSubFolder.Name
        Else
            pintLevel = UBound(Split(objSubFolder.Path, ""))
            RichTextBox1.Text = RichTextBox1.Text & vbCr & String(pintLevel - mintInitialIndent, "-") & objSubFolder.Name
        End If
        
        If pblnGetNestingSubfolders Then
            pintLevel = pintLevel + 1
            GetSubFolders objSubFolder.Path, pblnGetNestingSubfolders, pintLevel
        End If
    Next objSubFolder
 
End Function