Страницы: 1
RSS
Перебор файлов в папке вне выбранного списка, VBA
 
Уважаемые эксперты, посоветуйте пож-та доработку кода на предмет переборки в папке не выбранных в массив файлов и совершения с каждым одиночной операции с последующим сохранением. Цель всего мероприятия - пересборка массива с исключением из него более не выбранных в диалоговом окне файлов
Код
Sub ВыбратьФайлы()
    t = Timer
Dim vFolders(), lCount As Long
Dim objFSO As Object, objFolder As Object, objFile As Object
Dim sFolder As String, sFiles As String

     With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Выбрать файлы выгрузок 1С" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
'       .Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - xls files(Текстовые файлы)
        .InitialFileName = ActiveWorkbook.Sheets("БД").Range("B2").Value ' = sFolder С:\Temp\Книга1.xlsx" 'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
        If .Show = False Then Exit Sub
        For lf = 1 To .SelectedItems.Count
            X = .SelectedItems(lf) 'считываем полный путь к файлу
            Workbooks.Open X 'открытие книги
            'можно также без х
            'Workbooks.Open .SelectedItems(lf)
            ТиповойФайл

' ? открытие остальных файлов папки
' ? постановка отметки о неучастии в массиве
' ? выход с сохранением

        Next
    End With
    Application.ScreenUpdating = True
MsgBox "Обновлены остатки" & Chr(10) & Chr(10) & "Первичная дата выгрузки: " & ActiveWorkbook.Sheets("БД").Range("J1").Value & Chr(10) & Chr(10) & "Готово за:  " & TimeSerial(0, 0, (Timer - t)) & " сек.", vbInformation + vbMsgBoxSetForeground + vbSystemModal
End Sub
 
Код
Sub GetNotExistsFiles()
Dim lf As Long, iTemp, sFolder$, sFiles$, iStr$
sFolder = "D:\DOWNLOAD\"    'путь к папке
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Title = "Выбрать файлы отчетов" 'заголовок окна диалога
    .Filters.Clear 'очищаем установленные ранее типы файлов
    .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
    .InitialFileName = sFolder 'назначаем папку отображения и имя файла по умолчанию
    .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
    If .Show = 0 Then Exit Sub 'показывает диалог
    Set dic = CreateObject("Scripting.Dictionary")
    For lf = 1 To .SelectedItems.Count
        iTemp = dic(.SelectedItems(lf)) 'считываем полный путь к файлу
    Next
End With
sFiles = Dir(sFolder & "*.xls*")
Do While sFiles <> ""
    If Not dic.Exists(sFolder & sFiles) Then
        iStr = IIf(IsEmpty(iStr), sFiles, iStr & vbCrLf & sFiles)
    End If
    sFiles = Dir
Loop
MsgBox "В список выбранных файлов не вошли:" & vbCrLf & iStr
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Не совсем понимаю, что я делаю не так:

      Set СписокФайлов = Array(iStr)

никак не могу запустить поочередное открытие файлов из массива "вне списка"
 
во-первых здесь
Set СписокФайлов = Array(iStr)
не нужен Set, достаточно
СписокНеФайлов = Array(iStr)
во-вторых подозреваю что нужен не Array(iStr) , а Split(iStr, vbcrlf)
хотя если нужно исправить код - нужно вникать в него а если нужно решить задачу, то эту задачу достаточно просто описать, (код, который не решает задачу только отвлекает от понимания сути задачи)
Изменено: Ігор Гончаренко - 17.06.2019 01:46:16
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Игорь, да, весь процесс касается планирования ресурсов. Шаг чуть причесать выборочные файлы выгрузок 1С для последующей PQ сборки плоского массива из них.
Пришел к выводу, что неактуальные файлы могут изыматься/возвращаться в массив при любом невыборе/выборе в диалоговом окне. Некоторые элементы работы с переменными мною до конца не изучены, в то же время не пытаюсь целиковую разработку сделать чужими руками. Спасибо за комментарий
 
Код
Do While sFiles <> ""
    If Not dic.Exists(sFolder & sFiles) Then
        Set iWb = Workbooks.Open(sFolder & sFiles)  'открываем файл 'вне списка'
        'вместо сообщения вставьте нужный Вам код
        MsgBox "Открыт файл - '" & iWb.Name & "'"
        '---------------------------------------
        iWb.Close True  'закрываем модифицированный файл с сохранением изменений
    End If
    sFiles = Dir
Loop
Согласие есть продукт при полном непротивлении сторон
 
Sanja, Игорь, большое вам спасибо! Пока ещё полностью не разобрался что делают конструкции .SelectedItems(lf) и sFiles = Dir (что это за синтаксис с точкой), но работает всё шикарно как в аптеке))
Буду благодарен, если направите где можно почитать об операциях с переменными как iWb.Name, iWb.Close True, хотелось бы лучше понять что и как таким способом возможно с переменными делать
 
Цитата
Дмитрий Марков написал:
iWb.Name, iWb.Close
Это переменная типа Workbook, либо Variant которая в итоге преобразуется в Workbook
Цитата
Дмитрий Марков написал:
sFiles = Dir (что это за синтаксис с точкой)
первый раз прописывается путь к папке и типы файлов, далее если запустить в цикле буде поочередный перебор файлов при условии что в цикле будет прописано
Код
sFiles = Dir
второй и последующие разы в Dir не указываются параметры, функция сама присваивает переменной очередное имя файла, если файлы данного типа закончились, то переменная sFiles будет пустая, как раз это условие и проверяется циклом для его завершения.
Цитата
Дмитрий Марков написал:
.SelectedItems(lf)
поиск файла по индексу, т.е. по номеру строки в папке. Если повнимательней посмотреть, то if это счетчик цикла, который начинается с 1 и заканчивается числом равным количеству файлов в папке.
Как то так, вроде немного пояснил. Если, что то упустил, возможно автор кода подправит  ;)
"Все гениальное просто, а все простое гениально!!!"
 
Про FileDialog
Про Dir
Изменено: Nordheim - 17.06.2019 16:02:05
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, давно пытаюсь понимать эти механики, что-то по смыслу понятно, что-то уже обсуждено или увидено, а к чему-то непонятно с какой стороны подходить... вот Вы меня и направили - большое спасибо!
Страницы: 1
Наверх