Отбор файлов по списку и вывод на печать - VB
Формулировка задачи:
Помогите автоматизировать задачу
Есть список фрагментов названий файлов (колонка в Excel), по нему нужно искать файлы в заданном каталоге и выводить на печать найденные.Ссылка (битая) удалена
нашел частичное решение задачи, но ни как не получается переделать.
Решение задачи: «Отбор файлов по списку и вывод на печать»
textual
Листинг программы
Option Explicit Const inputFolder = "C:\temp\" 'корневая папка Const logName = "log.txt" 'будет создан или дополнен в inputFolder Dim folderCount As Long, stbar As Boolean, startTime As Date Dim frags() As String, fragsCount As Long Dim miDoc As Object, ff As Integer Sub Alexanderr() Dim x As Range, i As Long 'формируем массив со строками для сравнения Set x = Range("A1").End(xlDown) If x = "" Then x = Range("A1") 'в списке одно значение fragsCount = x.Row ReDim frags(fragsCount) For i = 1 To fragsCount frags(i) = "*" & Cells(i, 1) & "*" Next Set miDoc = CreateObject("modi.document") ff = FreeFile Open inputFolder & logName For Append As ff startTime = Time folderCount = 0 stbar = Application.DisplayStatusBar Application.DisplayStatusBar = True Print #ff, "******* начало печати файлов " & Date & " " & Time ' запускает процесс с исходной папки processFolder inputFolder Print #ff, "******* конец печати файлов " & Date & " " & Time & _ ", папок " & folderCount & ", время " & Format(Time - startTime, "hh:mm:ss") Close #ff Application.DisplayStatusBar = stbar Application.StatusBar = False Debug.Print folderCount & Format(Time - startTime, ", hh:mm:ss") End Sub Private Sub processFolder(fName As String) Dim fso As Object, file As Object, fileName As String, i As Long folderCount = folderCount + 1 Application.StatusBar = folderCount & " " & fName Set fso = CreateObject("scripting.filesystemobject") Set fso = fso.getfolder(fName) ' Для каждого файла в папке ... For Each file In fso.Files fileName = file.Name For i = 1 To fragsCount ' Если значение ячейки содержится в имени файла, то в файл-лог выводится путь к файлу, ' файл распечатывается If fileName Like frags(i) Then Print #ff, file.Path, On Error Resume Next miDoc.Create file.Path If Err Then Err.Clear Print #ff, "ERROR" Else Print #ff, "OK" miDoc.PrintOut End If Exit For End If Next Next ' Для каждой подпапки в папке просто вызывается эта же подпрограмма! For Each file In fso.subfolders processFolder file.Path Next End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д