Добрый день Знатоки. Помогите пожалуйста: - есть код уважаемого Дмитрия Щербакова, где список файлов выводится на Лист.
Код
'---------------------------------------------------------------------------------------
' Module : mGetAllFilefromFolder
' DateTime : 20.07.2012 13:56
' Author : The_Prist(Щербаков Дмитрий)
' WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' http://www.excel-vba.ru
' Purpose : http://www.excel-vba.ru/chto-umeet-excel/prosmotret-vse-fajly-v-papke/
'---------------------------------------------------------------------------------------
Option Explicit
Dim vFolders(), lCount As Long
Dim objFSO As Object, objFolder As Object, objFile As Object
Sub Get_All_File_from_Folder()
Dim sFolder As String, sFiles As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
sFolder = .SelectedItems(1)
End With
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
Application.ScreenUpdating = False
sFiles = Dir(sFolder & "*.xls*")
Do While sFiles <> ""
'заносим полное имя файла в список файлов
ReDim Preserve vFolders(lCount)
vFolders(lCount) = sFolder & sFiles
lCount = lCount + 1
'================================
'Открытие книг:
' 'открываем книгу
' Workbooks.Open sFolder & sFiles
' 'действия с файлом
' 'Запишем на первый лист книги в ячейку А1 - www.excel-vba.ru
' ActiveWorkbook.Sheets(1).Range("A1").Value = "www.excel-vba.ru"
' ActiveWorkbook.Close True
sFiles = Dir
MsgBox sFiles ' Как вывести весь список ???
Loop
' Range("A1").Resize(lCount).Value = Application.Transpose(vFolders)
Application.ScreenUpdating = True
End Sub
dim s$
sFiles = Dir(sFolde & r & "*.xls*")
Do While sFiles <> ""
s=s & sFiles & vbcrlf 'заносим полное имя файла в список файлов
ReDim Preserve vFolders(lCount)
vFolders(lCount) = sFolder & sFiles
lCount = lCount + 1
'================================
'Открытие книг:
' 'открываем книгу
' Workbooks.Open sFolder & sFiles
' 'действия с файлом
' 'Запишем на первый лист книги в ячейку А1 - www.excel-vba.ru
' ActiveWorkbook.Sheets(1).Range("A1").Value = "www.excel-vba.ru"
' ActiveWorkbook.Close True
sFiles = Dir
'MsgBox sFiles ' Как вывести весь список ???
Loop
MsgBox s 'Files ' Как вывести весь список ???
Sub NamesInFolder()
Dim f As String, s As String, fc, q
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Укажите рабочую папку": .Show
If .SelectedItems.Count = 0 Then Exit Sub Else f = .SelectedItems(1) & "\"
End With
Set fc = CreateObject("Scripting.FileSystemObject").GetFolder(f).Files
For Each q In fc: s = s & q.Name & vbCrLf: Next
MsgBox s
End Sub