Тема: Сжатие Pdf вложений в лотус документе.
Есть проблема - к лотус докментам прикрепляют огромные по размерам Pdf приложения, которые совсем не оптимизированы по сжатию. Размеры файликов бывают 100-300 Мб.
Вот пока первый вариант сжатия таких вложений с помощью gswin64c.exe - Ghostscript, программа.
Вызов функции.
Print "Вложение сжать: " + datpatch$ & oname$
If (obj.FileSize > 10214400 ) Then ' БОРЯ 2024
If ws.Prompt (PROMPT_YESNO, "Внимание", "Сжать ПДФ") = 1 Then Call Pdf_compact (datpatch$ , oname$ )
End If
Функция.
Function Pdf_compact(datpatch As String, oname As String) As String
On Error GoTo errh
Dim cmd As String
Dim Namepdf As String
Print "Pdf_compact старт"
Namepdf = datpatch & oname
If oname = "456-output.pdf" Then
cmd = datpatch & {gswin64c.exe}
cmd = cmd & { -sDEVICE=pdfwrite}
cmd = cmd & { -dCompatibilityLevel=1.7}
cmd = cmd & { -dNOPAUSE}
cmd = cmd & { -dBATCH}
cmd = cmd & { -sColorConversionStrategy=Gray}
cmd = cmd & { -dMonoImageResolution=60}
cmd = cmd & { -o"} & datpatch & {tmpout.pdf" -f"} & datpatch & oname & {"}
Print cmd
Dim WShell As Variant, WshExec As Variant
Dim OutStream As Variant, StdErr As String
Set WShell=Nothing
Set WshExec=Nothing
Set WShell = CreateObject("WScript.Shell")
Set WshExec = WShell.Exec(cmd) 'запускаем прогу
Sleep 3
While WshExec.Status=0 'ждем закрытия проги
Sleep 1
Wend
Set OutStream = WshExec.StdErr
While Not OutStream.AtEndOfStream
StdErr = StdErr & Trim(OutStream.ReadLine()) & Chr(13)
Wend
If Trim(StdErr)<>"" Then MsgBox StdErr
Sleep 1
Kill datpatch + oname
Name datpatch + "tmpout.pdf" As datpatch + oname
Sleep 1
Print "ЗАКРЫЛИ"
End If
Print "Pdf_compact END"
Exit Function
ErrH:
Print "Библиотека 'MED_XML' ф-ция 'pdf_compact'. Ошибка " & Error(Err) & " в строке " & Erl
Exit Function
End Function