I'm still working on this and finally i got the correct solution
I will now explain the process:
First i make a lot of reports.
Then i merge them into one PDF file.
Some clients are to have more than one copy so i create x number of the same PDF file and merge that into one file.
So now i have one file containing all the copies of the report.
Then i start sending the PDF file to the printer.
Then i found some VB code the are looking at the print jobs on the default printer, and loops until adobe are done spooling the PDF file.
When that are done i can kill Adobe reader:
Call Shell ( "taskkill / F / IM AcroRd32.exe" vbHide)
But if i don't make a wait function before and after the kill of adobe the system freezes for 2 minutes?
The wait function only takes 1 sec and then it works like a charm!
Her is my code:
'The code that calls the process:
Dim execmd As String
execmd = Chr(34) & RegKeyRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe\Path", 0) & "AcroRd32.exe" & Chr(34) & " /p /h " & Chr(34) & Application.CurrentProject.Path & "\Merge\" & pdfname & Chr(34)
For varloop = 1 To 2000
DoEvents
Next varloop
ExecuteAndWait execmd, pdfname
Public Sub ExecuteAndWait(cmdline$, pdfname As String)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
Dim varloop As Long
Dim boolcheck As Boolean
Dim winHwnd As Long
Dim TWait As Date
Dim longItemsinprinter As Long
winHwnd = 0
start.cb = Len(start)
boolcheck = False
ret = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
TWait = Time
TWait = DateAdd("s", 5, TWait)
Do Until DateAdd("s", 0, Time) >= TWait
Loop
longItemsinprinter = GetPrinterJobsCount(DefaultPrinter)
If longItemsinprinter > 0 Then
Do Until boolcheck = True
boolcheck = RefreshPrinterQueue(pdfname)
Loop
End If
For varloop = 1 To 2000
DoEvents
Next varloop
Call Shell("taskkill /F /IM AcroRd32.exe", vbHide)
For varloop = 1 To 2000
DoEvents
Next varloop
End Sub
Public Function DefaultPrinter() As String
Dim strReturn As String
Dim intReturn As Integer
strReturn = Space(255)
intReturn = GetProfileString("Windows", ByVal "device", "", strReturn, Len(strReturn))
If intReturn Then
strReturn = UCase(Left(strReturn, InStr(strReturn, ",") - 1))
End If
DefaultPrinter = strReturn
End Function
Public Function GetPrinterJobsCount(strPrinter As String) As Long
Dim hPrinter As Long
Dim lngJobsFirstJob As Long, lngJobsEnumJob As Long, lngJobsLevel As Long
Dim lngJobsNeeded As Long, lngJobsReturned As Long
Dim udtJobInfo1() As JOB_INFO_1
Dim lngJobsCount As Long
Dim lngResult As Long
lngResult = OpenPrinter(strPrinter, hPrinter, ByVal vbNullString)
lngJobsFirstJob = 0 ' zero-based position within the print queue of the first print job to enumerate
lngJobsEnumJob = 99 ' total number of print jobs to enumerate
lngJobsLevel = 1 ' Specifies whether the function should use JOB_INFO_1
' or JOB_INFO_2 structures to store data for the enumerated jobs
lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
lngJobsLevel, ByVal vbNullString, 0, _
lngJobsNeeded, lngJobsReturned)
' Check out the number of jobs hypothetically will be returned
If lngJobsNeeded > 0 Then
ReDim byteJobsBuffer(lngJobsNeeded - 1)
ReDim udtJobInfo1(lngJobsNeeded - 1)
lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
lngJobsLevel, byteJobsBuffer(0), lngJobsNeeded, _
lngJobsNeeded, lngJobsReturned)
' Check out the number of jobs returned
If lngJobsReturned > 0 Then
lngJobsCount = lngJobsReturned
Else
' number of jobs returned = 0 (no jobs)
lngJobsCount = 0
End If
Else
' number of jobs = 0 (no jobs)
lngJobsCount = 0
End If
lngResult = ClosePrinter(hPrinter)
GetPrinterJobsCount = lngJobsCount
End Function
Public Function RefreshPrinterQueue(pdfname As String) As Boolean
Dim hPrinter As Long
Dim lngJobsFirstJob As Long, lngJobsEnumJob As Long, lngJobsLevel As Long
Dim lngJobsNeeded As Long, lngJobsReturned As Long
Dim byteJobsBuffer() As Byte, udtJobInfo1() As JOB_INFO_1
Dim lngJobsCount As Long
Dim lngResult As Long
Dim strPrinterName As String
Dim byteBuffer(64) As Byte
Dim strDocument As String, strStatus As String, strOwnerName As String
Dim boolfilecontrol As Boolean
Dim itmX As ListItem
RefreshPrinterQueue = False
boolfilecontrol = False
strPrinterName = DefaultPrinter
lngResult = OpenPrinter(strPrinterName, hPrinter, ByVal vbNullString)
lngJobsFirstJob = 0 ' zero-based position within the print queue of the first print job to enumerate
lngJobsEnumJob = 99 ' total number of print jobs to enumerate
lngJobsLevel = 1 ' Specifies whether the function should use JOB_INFO_1
' or JOB_INFO_2 structures to store data for the enumerated jobs
lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
lngJobsLevel, ByVal vbNullString, 0, _
lngJobsNeeded, lngJobsReturned)
' Check out the number of jobs hypothetically will be returned
If lngJobsNeeded > 0 Then
ReDim byteJobsBuffer(lngJobsNeeded - 1)
ReDim udtJobInfo1(lngJobsNeeded - 1)
lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
lngJobsLevel, byteJobsBuffer(0), lngJobsNeeded, _
lngJobsNeeded, lngJobsReturned)
' Check out the number of jobs returned
If lngJobsReturned > 0 Then
MoveMemory udtJobInfo1(0), byteJobsBuffer(0), Len(udtJobInfo1(0)) * lngJobsReturned
For lngJobsCount = 0 To lngJobsReturned - 1
With udtJobInfo1(lngJobsCount)
' Get the document name
lngResult = lstrcpy(byteBuffer(0), ByVal .pDocument)
strDocument = StrConv(byteBuffer(), vbUnicode)
' Document name has been returned as null terminated-string
strDocument = Left$(strDocument, InStr(strDocument, vbNullChar) - 1)
' Get the document's owner name
lngResult = lstrcpy(byteBuffer(0), ByVal .pUserName)
strOwnerName = StrConv(byteBuffer(), vbUnicode)
' Document's owner name has been returned as null-terminated string
strOwnerName = Left$(strOwnerName, InStr(strOwnerName, vbNullChar) - 1)
' Translate status
strStatus = ""
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_DELETING, "Deleting")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_ERROR, "Error")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_OFFLINE, "Offline")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_PAPEROUT, "Out of paper")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_PAUSED, "Paused")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_PRINTED, "Printed")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_PRINTING, "Printing")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_SPOOLING, "Spooling")
If strDocument = pdfname And (InStr(strStatus, "Spooling") > 0 Or InStr(strStatus, "Out of paper") > 0 Or InStr(strStatus, "Error") > 0) Then
RefreshPrinterQueue = False
End If
If strDocument = pdfname Then
boolfilecontrol = True
End If
End With
Next lngJobsCount
Else
' number of jobs returned = 0 (no jobs)
lngJobsCount = 0
End If
Else
' number of jobs = 0 (no jobs)
lngJobsCount = 0
RefreshPrinterQueue = True
End If
lngResult = ClosePrinter(hPrinter)
If boolfilecontrol = False Then
RefreshPrinterQueue = True
End If
End Function