Добрый день, всем! Обратились ко мне коллеги с просьбой упростить им жизнь (так как я чуть чуть знаю VBA и Excel). Люди они хорошие, решил им помочь. Суть проблемы в том, что они формируют описи для эл. документов (сканы pdf файлов) Делают таблицу Excel в которой пишут: Номер группы документа, Имя файла, количество страниц, путь к нему. Файлы лежат в папке "0.Опись" и называются (пример) "1.13 Ведомость.pdf"... "1.13 Опросной лист.pdf" ... "2.10 Сводный лист.pdf" (в итоге получается опись с разбивкой по группам 1.1 ... 1.2... 2.10... и т.д.)
Почти все реализовал, кроме одного момента... В сети нашел пример кода для подсчета страниц в pdf (спасибо добрым людям), код работает Но столкнулся с неприятным моментом... иногда на некоторых файлах выдается ошибка "input past end of file". Из описания ошибки понял, что проблема в самом pdf и так как pdf приходят "из вне", то исправить такие ошибки не представляется возможным(то ли от сканировали не так, то ли данные в файле не того вида... точно не понял)
Поэтому вижу только один выход, пропускать дынный фаил и делать помету (например выделение цветом ячейку с п. "1.13"). Что бы потом пользователи в ручную вносили корректировки в итоговую опись. Понятно, что это "кривое" решение, но люди и этому будут рады...
И тут вопрос... Как обработать/пропустить ошибки в VBA? Возможно это? Я с этим не сталкивался...
Вот пример кода, который считает страницы в pdf [vba]
Код
Sub fileName() Dim fso, myPath, myFolder, myFile, myFilesPath(), myFilesName(), i, j Dim iPath As String 'Записываем в переменную myPath полное имя папки myPath = ThisWorkbook.path & "\0.Опись\" Set fso = CreateObject("Scripting.FileSystemObject") Set myFolder = fso.GetFolder(myPath) If myFolder.Files.Count = 0 Then MsgBox "В папке «" & myPath & "» файлов нет" Exit Sub End If ReDim myFilesPath(1 To myFolder.Files.Count) ReDim myFilesName(1 To myFolder.Files.Count) For Each myFile In myFolder.Files i = i + 1 myFilesPath(i) = myFile.path myFilesName(i) = myFile.Name Debug.Print myFilesName(i) Next Debug.Print "Фильтр = " & UBound(myFilesName) For j = 1 To UBound(myFilesName) If myFilesName(j) Like "1.13 *" Then 'метка имени файла, в котором считаем страницы - нужна для группировки iPath = myFilesPath(j) Call PDFCount(iPath) End If Next j End Sub Function PDFCount(PDFИмя As String) PDFCount = 1 Ищем = "/Count" Разделитель = Chr(10) Open PDFИмя For Binary Access Read Lock Read As #1 While Not EOF(1) Line Input #1, fstr If InStr(fstr, Ищем) > 0 Then PDFCount = word(fstr) End If Wend Close #1 Debug.Print PDFИмя & ": Страниц = " & PDFCount End Function
[/vba]
Одним словом, буду очень благодарен если кто-нибудь, что-нибудь подскажет или даст наводку где почитать. Всем заранее спасибо!
З.Ы. Пример выложить, к сожалению не могу, так как все файлы на рабочем компьютере и их не скачать.
Добрый день, всем! Обратились ко мне коллеги с просьбой упростить им жизнь (так как я чуть чуть знаю VBA и Excel). Люди они хорошие, решил им помочь. Суть проблемы в том, что они формируют описи для эл. документов (сканы pdf файлов) Делают таблицу Excel в которой пишут: Номер группы документа, Имя файла, количество страниц, путь к нему. Файлы лежат в папке "0.Опись" и называются (пример) "1.13 Ведомость.pdf"... "1.13 Опросной лист.pdf" ... "2.10 Сводный лист.pdf" (в итоге получается опись с разбивкой по группам 1.1 ... 1.2... 2.10... и т.д.)
Почти все реализовал, кроме одного момента... В сети нашел пример кода для подсчета страниц в pdf (спасибо добрым людям), код работает Но столкнулся с неприятным моментом... иногда на некоторых файлах выдается ошибка "input past end of file". Из описания ошибки понял, что проблема в самом pdf и так как pdf приходят "из вне", то исправить такие ошибки не представляется возможным(то ли от сканировали не так, то ли данные в файле не того вида... точно не понял)
Поэтому вижу только один выход, пропускать дынный фаил и делать помету (например выделение цветом ячейку с п. "1.13"). Что бы потом пользователи в ручную вносили корректировки в итоговую опись. Понятно, что это "кривое" решение, но люди и этому будут рады...
И тут вопрос... Как обработать/пропустить ошибки в VBA? Возможно это? Я с этим не сталкивался...
Вот пример кода, который считает страницы в pdf [vba]
Код
Sub fileName() Dim fso, myPath, myFolder, myFile, myFilesPath(), myFilesName(), i, j Dim iPath As String 'Записываем в переменную myPath полное имя папки myPath = ThisWorkbook.path & "\0.Опись\" Set fso = CreateObject("Scripting.FileSystemObject") Set myFolder = fso.GetFolder(myPath) If myFolder.Files.Count = 0 Then MsgBox "В папке «" & myPath & "» файлов нет" Exit Sub End If ReDim myFilesPath(1 To myFolder.Files.Count) ReDim myFilesName(1 To myFolder.Files.Count) For Each myFile In myFolder.Files i = i + 1 myFilesPath(i) = myFile.path myFilesName(i) = myFile.Name Debug.Print myFilesName(i) Next Debug.Print "Фильтр = " & UBound(myFilesName) For j = 1 To UBound(myFilesName) If myFilesName(j) Like "1.13 *" Then 'метка имени файла, в котором считаем страницы - нужна для группировки iPath = myFilesPath(j) Call PDFCount(iPath) End If Next j End Sub Function PDFCount(PDFИмя As String) PDFCount = 1 Ищем = "/Count" Разделитель = Chr(10) Open PDFИмя For Binary Access Read Lock Read As #1 While Not EOF(1) Line Input #1, fstr If InStr(fstr, Ищем) > 0 Then PDFCount = word(fstr) End If Wend Close #1 Debug.Print PDFИмя & ": Страниц = " & PDFCount End Function
[/vba]
Одним словом, буду очень благодарен если кто-нибудь, что-нибудь подскажет или даст наводку где почитать. Всем заранее спасибо!
З.Ы. Пример выложить, к сожалению не могу, так как все файлы на рабочем компьютере и их не скачать.Benos
Воспользовался советом... пропуск ошибки работает, но вот условия не срабатывают... начал копать код... после сроки [vba]
Код
Line Input #1, fstr
[/vba] макрос падает...
Начал анализировать фаил на котором выпадает ошибка нашел разницу в следующем... В файлах в которых идет нормальный подсчет страниц - каретка переносится UNIX(LF), фаил который вешает макрос Macintosh(CR). Как я понял, скан сделан на Мак, поэтому конец страницы не найти (нашел информацию у Майкрософт)
Перегнал фаил через pdf24, теперь фаил UNIX(LF) и макрос работает корректно... Пока не нашел информацию как определить... тип переноса новой строки в скане (LF или CR) Буду думать, как определить и унифицировать скрипт под Мак и Виндовс
Воспользовался советом... пропуск ошибки работает, но вот условия не срабатывают... начал копать код... после сроки [vba]
Код
Line Input #1, fstr
[/vba] макрос падает...
Начал анализировать фаил на котором выпадает ошибка нашел разницу в следующем... В файлах в которых идет нормальный подсчет страниц - каретка переносится UNIX(LF), фаил который вешает макрос Macintosh(CR). Как я понял, скан сделан на Мак, поэтому конец страницы не найти (нашел информацию у Майкрософт)
Перегнал фаил через pdf24, теперь фаил UNIX(LF) и макрос работает корректно... Пока не нашел информацию как определить... тип переноса новой строки в скане (LF или CR) Буду думать, как определить и унифицировать скрипт под Мак и Виндовс Benos
Решить так и не получилось, но поиски привели меня к другому коду. Если кто будет решать такие же задачи... вот оно... чудо [vba]
Код
Sub Test() Dim I As Long Dim xRg As Range Dim xStr As String Dim xFd As FileDialog Dim xFdItem As Variant Dim xFileName As String Dim xFileNum As Long Dim RegExp As Object Set xFd = Application.FileDialog(msoFileDialogFolderPicker) If xFd.Show = -1 Then xFdItem = xFd.SelectedItems(1) & Application.PathSeparator xFileName = Dir(xFdItem & "*.pdf", vbDirectory) Set xRg = Range("A1") Range("A:B").ClearContents Range("A1:B1").Font.Bold = True xRg = "File Name" xRg.Offset(0, 1) = "Pages" I = 2 xStr = "" Do While xFileName <> "" Cells(I, 1) = xFileName Set RegExp = CreateObject("VBscript.RegExp") RegExp.Global = True RegExp.Pattern = "/Type\s*/Page[^s]" xFileNum = FreeFile Open (xFdItem & xFileName) For Binary As #xFileNum xStr = Space(LOF(xFileNum)) Get #xFileNum, , xStr Close #xFileNum Cells(I, 2) = RegExp.Execute(xStr).Count I = I + 1 xFileName = Dir Loop Columns("A:B").AutoFit End If End Sub
[/vba]
Пусть у создателя этого кода все будет хорошо!
Решить так и не получилось, но поиски привели меня к другому коду. Если кто будет решать такие же задачи... вот оно... чудо [vba]
Код
Sub Test() Dim I As Long Dim xRg As Range Dim xStr As String Dim xFd As FileDialog Dim xFdItem As Variant Dim xFileName As String Dim xFileNum As Long Dim RegExp As Object Set xFd = Application.FileDialog(msoFileDialogFolderPicker) If xFd.Show = -1 Then xFdItem = xFd.SelectedItems(1) & Application.PathSeparator xFileName = Dir(xFdItem & "*.pdf", vbDirectory) Set xRg = Range("A1") Range("A:B").ClearContents Range("A1:B1").Font.Bold = True xRg = "File Name" xRg.Offset(0, 1) = "Pages" I = 2 xStr = "" Do While xFileName <> "" Cells(I, 1) = xFileName Set RegExp = CreateObject("VBscript.RegExp") RegExp.Global = True RegExp.Pattern = "/Type\s*/Page[^s]" xFileNum = FreeFile Open (xFdItem & xFileName) For Binary As #xFileNum xStr = Space(LOF(xFileNum)) Get #xFileNum, , xStr Close #xFileNum Cells(I, 2) = RegExp.Execute(xStr).Count I = I + 1 xFileName = Dir Loop Columns("A:B").AutoFit End If End Sub
[/vba]
Пусть у создателя этого кода все будет хорошо!Benos