1 Тема от admin

  • admin
  • admin
  • Administrator
  • Неактивен
  • Зарегистрирован: 2010-04-07
  • Сообщений: 1,223
  • Репутация : 0

Тема: Сжатие 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

Поделиться