使用VBA / Excel打印或转换HTML文件为PDF

时间:2018-06-08 21:06:26

标签: html vba excel-vba pdf excel

所有

我有几千个html文件,我必须附加到电子邮件和发送。问题是文件中嵌入了img标签中的图像,因此当用户收到并打开附加的文件时,显示错误。

我必须解决此问题的第一个想法是在浏览器中打开每个文件,然后打印到PDF。

我有两种方法,但没有一种能按预期工作:

1 - 在Internet Explorer中打开html文件,然后使用PDFcreator对象进行打印,在html中编码一些条形码,使得pdf变得无用。

2 - 在Internet Explorer中打开html文件,然后使用“Microsoft Print to PDF”虚拟打印机按预期保存文件 - 所有图像,右条形码 - 但在保存之前会提示输入文件名并保存每个文件的路径。

第二种方法似乎会带来更好的结果。实际上这是不切实际的。

那么,有没有办法避免“Microsoft Print to PDF”打印机提示,在excel vba中以编程方式设置路径和文件名?

如何在开始新循环之前让ExecWB等待?

PDFcreator方法:

Sub PrintViaPDFCREATOR()

    'Creates PDF Creator object, killing any if already opened:    
    Dim pdfjob As PDFCreator.clsPDFCreator
    Do
        DoEvents
        bRestart = False
        Set pdfjob = New PDFCreator.clsPDFCreator
        If pdfjob.cStart("/NoProcessingAtStartup") = False Then
            Shell "taskkill /f /im PDFCreator.exe", vbHide
            Set pdfjob = Nothing
            bRestart = True
        End If
    Loop Until bRestart = False

    Dim IE As InternetExplorer
    Set IE = New InternetExplorer
    IE.Visible = True

    Dim FSO As Scripting.FileSystemObject
    Dim objfolder As Scripting.Folder
    Dim objfiles As Scripting.Files
    Dim F As Scripting.File

    FilePath = ThisWorkbook.Path & "\MyFolder\"
    Set FSO = New Scripting.FileSystemObject
    Set objfolder = FSO.GetFolder(FilePath)
    Set objfiles = objfolder.Files
    For Each F In objfiles

        IE.Navigate2 F.Path
        Do While IE.readyState <> 4
            DoEvents
        Loop

        'PDF creator Settings
        With pdfjob
            .cOption("UseAutoSave") = 1
            .cOption("UseAutosaveDirectory") = 1
            .cOption("AutosaveDirectory") = FilePath
            .cOption("AutosaveFilename") = Replace(F.Name, ".htm", ".pdf")
            .cOption("AutosaveFormat") = 0    ' 0 = PDF
            .cClearCache
        End With

        'Prints without prompt :)
        IE.ExecWB 6, 2, "", ""

        'Hold on til Job is finished
        Do Until pdfjob.cCountOfPrintjobs = 1
            DoEvents
        Loop

        pdfjob.cPrinterStop = False

        'Check if there is any file in the queue
        Do Until pdfjob.cCountOfPrintjobs = 0
            DoEvents
        Loop

    Next

    pdfjob.cClose
    Set pdfjob = Nothing

End Sub

此代码的问题:html文件中有一些条形码由许多div的1到2px边框组成。通过这种方法,pdf具有无法识别的条形码。它似乎在转换期间合并了一些“条形”,使其无法用于光学扫描仪。

Microsoft Print to PDF方法:

Sub PrintViaMicrosoftToPDF()
    'Save the current active printer for later reset:
    Dim OldPrinter
    OldPrinter = Trim(Split(Application.ActivePrinter, "in")(0))

    'Define the new active printer
    CreateObject("WScript.Network").SetDefaultPrinter "Microsoft Print to PDF"

    Dim objShell
    Set objShell = CreateObject("WScript.Shell")

    Dim IE As InternetExplorer
    Set IE = New InternetExplorer
    IE.Visible = True

    Dim FSO As Scripting.FileSystemObject
    Dim objfolder As Scripting.Folder
    Dim objfiles As Scripting.Files
    Dim F As Scripting.File

    FilePath = ThisWorkbook.Path & "\MyFolder\"
    Set FSO = New Scripting.FileSystemObject
    Set objfolder = FSO.GetFolder(FilePath)
    Set objfiles = objfolder.Files

    For Each F In objfiles

        IE.Navigate2 F.Path
        Do While IE.readyState <> 4
            DoEvents
        Loop

        'Prints but prompts :(
        IE.ExecWB 6, 2, "", ""

    Next

    'Reset Printer
    CreateObject("WScript.Network").SetDefaultPrinter OldPrinter
End Sub

此代码出现问题:它以pdf格式打印正确的文档,但用户必须选择保存路径和文件名。

如果有其他方式发送附加到eamil消息的html文件,包含嵌入的图像而不进行转换,或者其他方式与文件转换有关,我也会逐渐接受。

但我只限于Excel / Vba。

提前致谢。

0 个答案:

没有答案