Excel 中的 VBA 在循环后无法通过 PDFCreator 进行打印

Question

我编写了一些代码，从第一个选项卡上的 3 列（1000 行数据）获取信息，以填充第二个选项卡上的数据（根据帐户信息地址等制作套用信函）。代码进入 Do While，当代码继续循环时，在将 PDF 发送到队列后，会出现问题。该错误仅在运行代码时发生，单步执行代码时没有问题。

我在 2003 年和 2007 年都尝试过此操作，结果相似（2003 年将打印 3 个文件，2007 年最多可打印 6 个文件）

我还尝试

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

在作业进入打印时 添加手动延迟我还添加了一个 Do Until循环

 Sleep 3000 

来等待打印作业降至零但没有成功。

完整的代码是：

Sub PlaceData()

Dim accountNumber As String
Dim partyID As String
Dim ClientAddress As String
Dim bRestart As Boolean
Dim totalAccounts As Long
Dim pdfjob As PDFCreator.clsPDFCreator
Dim dataPage As Worksheet
Dim letterPage As Worksheet
Dim CB As Workbook 'CB = ClientBook

Set CB = ThisWorkbook
Set dataPage = CB.Sheets("Data")
Set letterPage = CB.Sheets("Letter")


'will iterate through the account numbers down

therow = 1
'where the loop starts
totalAccounts = dataPage.Cells(Rows.Count, 1).End(xlUp).Row

Do While therow < totalAccounts
therow = therow + 1

'for the form letter

letterPage.Range("F4").FormulaR1C1 = dataPage.Range("A" & therow)
letterPage.Range("F5").FormulaR1C1 = dataPage.Range("C" & therow)
letterPage.Range("B10").FormulaR1C1 = dataPage.Range("B" & therow)


'accountnumber minus one digit for the file name
accountNumber = letterPage.Range("F4").Text
accountNumberShort = Mid(accountNumber, 1, 8)

On Error GoTo EarlyExit
Application.ScreenUpdating = False
Set pdfjob = New PDFCreator.clsPDFCreator
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator

'Check if PDFCreator is already running and attempt to kill the process if so

Do
    bRestart = False
    Set pdfjob = New PDFCreator.clsPDFCreator
    If pdfjob.cStart("/NoProcessingAtStartup") = False Then
        'PDF Creator is already running.  Kill the existing process
        Shell "taskkill /f /im PDFCreator.exe", vbHide
        DoEvents
        Set pdfjob = Nothing
        bRestart = True
    End If
Loop Until bRestart = False

With pdfjob
    .cOption("UseAutosave") = 1
    .cOption("UseAutosaveDirectory") = 1
    .cOption("AutosaveDirectory") = sPDFPath
    .cOption("AutosaveFilename") = accountNumberShort
    .cOption("AutosaveFormat") = 0    ' 0 = PDF
    .cClearCache
End With

        'Delete the PDF if it already exists
        If Dir(sPDFPath & accountNumberShort) = accountNumberShort Then Kill (sPDFPath & accountNumberShort)

'Print the document to PDF

        letterPage.PrintOut copies:=1, ActivePrinter:="PDFCreator"

        'Wait until the print job has entered the print queue
        Do Until pdfjob.cCountOfPrintjobs = 1
            DoEvents
        Loop
        pdfjob.cPrinterStop = False

 'Wait until PDF creator is finished then release the objects

        Do Until pdfjob.cCountOfPrintjobs = 0
            DoEvents
        Loop

Loop

'where the loop will end and where the issue is (I think)

'cleanups

Cleanup:
'Release objects and terminate PDFCreator
Set pdfjob = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub

EarlyExit:
'Inform user of error, and go to cleanup section
MsgBox "There was an error encountered.  PDFCreator has" & vbCrLf & _
       "has been terminated.  Please try again.", _
       vbCritical + vbOKOnly, "Error"
Resume Cleanup

Set CB = Nothing
Set dataPage = Nothing
Set letterPage = Nothing
Set pdfjob = Nothing

End Sub

感谢您的任何意见或建议，

Answer 1

我会在完成工作后添加 PDFCreator (PDFC) 的正确处理，因为不正确的处理可能会导致 PDFC 重复运行时出现问题（剩余进程、资源等）。 PDFC 附带的所有代码示例至少至少实现了处置，即它们至少调用 clsPDFCreator.cClose() 方法。

例如，检查示例文件C:\Program Files (x86)\PDFCreator\COM\VB6\Sample1\Form1.frm（如果您将PDFC安装到不同目录，请调整路径）。示例中找到的代码：

 If noStart = False Then
   PDFCreator1.cClose   ' sending cleanup&exit request to PDFCreator
   While PDFCreator1.cProgramIsRunning ' loop while PDFCreator is not found finished
     DoEvents
     Sleep 100 ' polling interval 100 ms
   Wend
 End If

 Set PDFCreator1 = Nothing
 Set pErr = Nothing
 Set opt = Nothing

其他发货的示例有时会显示一些额外的技巧，但没有遗漏处理部分。