Страницы: 1
RSS
Копирование CSV файлов в один файл EXCEL из определенной папки, Копирование CSV файлов в один файл EXCEL из определенной папки
 
Добрый день.
Нашёл код
Код
Sub CombineWorkbooks()    Dim FilesToOpen
    Dim x As Integer
 
    Application.ScreenUpdating = False  'отключаем обновление экрана для скорости
     
    'вызываем диалог выбора файлов для импорта
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:="Files to Merge")
 
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбрано ни одного файла!"
        Exit Sub
    End If
     
    'проходим по всем выбранным файлам
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        importWB.Close savechanges:=False
        x = x + 1
    Wend
 
    Application.ScreenUpdating = True
End Sub

Код замечательно работает.
Но столкнулся с проблемой, что нужен выбор данных по умолчанию из заранее прописанной ссылки в макросе (должны забираться все CSV файлы из прописанной папки, но в папке могут лежать файлы и других форматов).

Буду рад если у кого-то возникнут идеи, что нужно переделать в этом коде.
 
Т.к. файлы выбираете сами вручную - сами себе и хозяин, выбирайте только csv.
Можно ведь открыть каталог как список и отсортировать по типу - будут все csv рядышком, выделяйте без лишних.
Но можно подстраховаться - перед открытием проверить расширение. Но зачем? Пропадёт универсальность кода.
Или настройте фильтр на csv:
Код
FileFilter:="All files (*.csv), *.csv"
Изменено: Hugo - 09.01.2021 15:33:47
 
Соглашусь про универсальность кода, но тут исключительная ситуация, когда вот по зарез нужно ограничить выбор и количество нажатий, поэтому и ищу способ, чтобы забрать только CSV файлы из конкретной папки (без права выбора).
 
Здравствуйте, попробуйте так:
Код
Sub GetFilesCSV()
Dim FSO As Object, objFolder As Object
Dim wbOpen As Workbook, objFile As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Выбрать папку"
    .ButtonName = "Выбрать папку"
    .Filters.Clear
    .InitialFileName = "C:\Temp\"
    .InitialView = msoFileDialogViewLargeIcons
    If .Show = 0 Then Exit Sub
    Set objFolder = FSO.GetFolder(.SelectedItems(1))
End With
For Each objFile In objFolder.Files
    If UCase(objFile.Name) Like "*.CSV" Then
        Set wbOpen = Workbooks.Open(objFile.Path)
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        wbOpen.Close False
    End If
Next objFile
Set FSO = Nothing
End Sub

Изменено: Dmitriy XM - 09.01.2021 16:07:26
 
Dir(tmpFolder & "*.CSV") и цикл Do Loop.
 
Dmitriy XM, в вашем варианте, всё равно необходимо выбирать папку (а идея в том, чтобы уже в макросе был прописан путь к папке).
 
Замените на:
Код
Sub GetFilesCSV()
Dim FSO As Object, objFolder As Object
Dim wbOpen As Workbook, objFile As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("ВОТ СЮДА ПОЛНЫЙ ПУТЬ К ПАПКЕ")
For Each objFile In objFolder.Files
    If UCase(objFile.Name) Like "*.CSV" Then
        Set wbOpen = Workbooks.Open(objFile.Path)
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        wbOpen.Close False
    End If
Next objFile
Set FSO = Nothing
End Sub
 
Большущее спасибо, всё работает!
Прям праздник какой-то. По доброму завидую вашим навыкам.
Страницы: 1
Наверх