Добрый день всем, в общем сделал я себе такую вот кракозябру для Word (да, Франкенштейн я еще тот), и в принципе она даже работает, идет в указанную папку, перебирает все лежащие там pdf файлы, открывает каждый, меняет пробелы на табуляции и таб+абзац - на абзацы, а потом чистит от повторов табуляций, итог сохраняет как mht.
Да медленно, однако вполне самостоятельно, НО... происходит это ровно до тех, пор пока не случается ЭТО: - "При попытке открытия PDF превышен максимальный размер страницы допустимый в word"
Да, я объявил ему False и на алерт и на обновление экрана, но... видимо он в "пакетном режиме", ответил мне "ФакЮл...ссс", на все мои заявы (открыть файл в скрытом режиме я кстати тоже пробовал, что бы меньше моргал, он даже согласился работать, правда вложенный макрос выполнять отказался), но если с морганием экрана я еще готов смириться (все равно я смотреть на экран пока он трудиться не планирую), то с остановкой работы я согласиться не могу, подскажите пожалуйста, как можно заставить его, если уж не отключить данную заразу совсем, то хотя бы при встрече, закрыть ее по "Ok", и продолжить работу?!!! В идеале бы конечно еще и имя сбойнувшего файла сообщить в файлике лога по итогу, но это уже из области МЯЧТА...
P.s. Сори, не знаю как тут код оформить, приложил кусочек в спойлер, весь в приложенном доке...
Спойлер
Application.ScreenUpdating = False
Application.DisplayAlerts = False
sFileName = Dir(sDir & Application.PathSeparator & "*.pdf")
While Len(sFileName) > 0
sFileName = sDir & Application.PathSeparator & sFileName
Set oDoc = Documents.Open(sFileName, False, False, False)
' Set oDoc = Documents.Open(sFileName, False, False, False, , , , , , , , False)
Application.Run MacroName:="ReplaceAll"
oDoc.SaveAs Mid(sFileName, 1, InStrRev(sFileName, ".")) & "mht", wdFormatWebArchive, AddToRecentFiles:=False
oDoc.Close
sFileName = Dir
i = i + 1
DoEvents
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Написал вам два письма на почту с заголовком "Письмо с Форума по VBA, Excel и Word". Написал именно на почту, а не на форум.
Нужно использовать "перехватчик ошибок" - On Error.
Код
Sub SaveAllToWebClean_1()
'
' Замена абзацев и пробелов на знаки табуляции, удаление повторяющихся табуляций
' Сохранение в формате mht (html одним файлом)
'
Dim sDir As String
Dim sFileName As String
Dim oDoc As Document, Errors As String
Dim i As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Выбрать папку"
If .Show Then sDir = .SelectedItems(1) Else Exit Sub
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
sFileName = Dir(sDir & Application.PathSeparator & "*.pdf")
While Len(sFileName) > 0
sFileName = sDir & Application.PathSeparator & sFileName
On Error Resume Next
Set oDoc = Nothing
Set oDoc = Documents.Open(sFileName, False, False, False)
On Error GoTo 0
If oDoc Is Nothing Then
Errors = Errors & sFileName & vbCr
Else
Application.Run MacroName:="ReplaceAll"
oDoc.SaveAs Mid(sFileName, 1, InStrRev(sFileName, ".")) & "mht", wdFormatWebArchive, AddToRecentFiles:=False
oDoc.Close
sFileName = Dir
i = i + 1
DoEvents
End If
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
If Errors <> "" Then
MsgBox "Ошибки в этих файлах:" & vbCr & Errors, vbExclamation
Else
MsgBox "Завершено. Сохранено " & i & " файлов.", vbInformation
End If
End Sub