ShellExecute Print AND wait

Du skal bruge ShellExecuteEx() eller gå direkte til hestens hoved:

Public Sub ExecuteAndWait(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim START As STARTUPINFO
Dim ret As Long

' Initialize the STARTUPINFO structure:
START.cb = Len(START)

' Start the shelled application:
ret = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, START, proc)
If ret Then
' Wait for the shelled application to finish:
ret = WaitForSingleObject(proc.hProcess, INFINITE)
End If
CloseHandle (proc.hProcess)
End Sub

Dit forslag lyder rigtig godt, men kan du give et eksempel på en cmdline hvor du laver samme handling som:

ShellExecute(0, "print", PDFname, "", "", SW_MINIMIZE)

Altså udskriver en pdf fil på en printer?

Nu har jeg ingen printer på denne box, men jeg ved hvad du mener. Lad mig lige lege lidt med det så vender jeg tilbage.

OK! det er godt nok 10 år siden jeg sidst har rodet med den slags kode :-) og nu begynder det at blive lidt langhåret.

I mit eksempel bruger vi ikke ShellExecute(Ex) men viser dig hvordan ShellExecute faktisk ser ud i Windows API.

Vi kalder den så ExecuteAndWait. (koden er kopieret fra nettet og er ikke noget jeg har skrevet)

Denne kode giver dig fuldstændig kontrol over hvad der foregår og som du sikkert kan læse, kan den bruges til mange andre ting end kun at printe, derfor valgte jeg at "pensle" det ud og give dig et indblik i Windows API

I bund og grund kan du starte hvad som helst med samme funktion som en kommando prompt eller CMD, med den forskel at din kode i access (VBA)stopper ved WaitForSingleObject() indtil det du har startet er afviklet eller afbrudt.

Nedenstående kode er testet på en access 2007

Option Compare Database
Option Explicit

'*******************************
' Type Definition for ExecCmd
'*******************************
      Private Type STARTUPINFO
        cb As Long
        lpReserved As String
        lpDesktop As String
        lpTitle As String
        dwX As Long
        dwY As Long
        dwXSize As Long
        dwYSize As Long
        dwXCountChars As Long
        dwYCountChars As Long
        dwFillAttribute As Long
        dwFlags As Long
        wShowWindow As Integer
        cbReserved2 As Integer
        lpReserved2 As Long
        hStdInput As Long
        hStdOutput As Long
        hStdError As Long
      End Type

      Private Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessID As Long
        dwThreadID As Long
      End Type

      Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
        hHandle As Long, ByVal dwMilliseconds As Long) As Long

      Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
        lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
        lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
        ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
        ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
        lpStartupInfo As STARTUPINFO, lpProcessInformation As _
        PROCESS_INFORMATION) As Long

      Private Declare Function CloseHandle Lib "kernel32" (ByVal _
        hObject As Long) As Long

      Private Const NORMAL_PRIORITY_CLASS = &H20&
      Private Const INFINITE = -1&



Public Sub ExecuteAndWait(cmdline$)
        Dim proc As PROCESS_INFORMATION
        Dim START As STARTUPINFO
        Dim ret As Long

        ' Initialize the STARTUPINFO structure:
        START.cb = Len(START)

        ' Start the shelled application:
        ret = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, _
            NORMAL_PRIORITY_CLASS, 0&, 0&, START, proc)
        If ret Then
            ' Wait for the shelled application to finish:
            ret = WaitForSingleObject(proc.hProcess, INFINITE)
        End If
        CloseHandle (proc.hProcess)
End Sub


Private Sub Command0_Click()
  'ExecuteAndWait ("Notepad.exe")
  ExecuteAndWait ("Print c:\boot.ini")
End Sub

tja...den åbner et cmd vindue hvor den skriver at den vil printe PDF filen, men der sker intet på printeren. Og intet bliver sendt til den.

Hmm! prøv:


PRINT [/D:enhed] [[drev:][sti]filnavn[...]]

  /D:enhed:  Angiver, hvilken udskriftsenhed der skal bruges.

det lader til at det er her den går galt:
CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
Det er med stor sandsynlighed cmdline$ der er problemet. Men jeg er usikker på hvordan den kan/skal sættes op i forhold til at der skal bruge default printer på brugerens computer.

Ja, det er også der jeg står af. Jeg kan, som sagt, ikke lige teste denne del uden en printer. Men hvad med /D:enhed ? hvis du angiver navnet på printeren som den fremgår af kontrolpanelet.

PS: når koden virker kan du "skjule" command/cmd prompten, hvis du ikke lige gider at se på den.

Det virker nu hvor jeg har fået enhed med, men den holder ikke formatet, nogle af siderne er i landscape :-(

Jeg fandt dette men kan ikke lige få det til at virke. Den sender ikke noget til printeren.

http://support.adobe.com/devsup/devsup.nsf/docs/52080.htm

Hvad med din egen kode? der gik jeg ud fra at det virkede. Så det bør også virke med den nye kode.

måske det er dine *knyffer* den er galt med. Udskift " med '

Okay, dette lader til at virke hvis jeg sætter følgende ind i RUN:
AcroRd32.exe /p C:\UK\Merge\FI8263.pdf

Men hvis jeg sætter samme sætning ind i ExecuteAndWait så sker der intet :-(

Har du nogen ide til hvorfor?

prøv lige at give den den fuld sti til AcroRd32.exe

Hos mig er den C:\Programmer\Adobe\Acrobat 4.0\Reader\AcroRd32.exe

Det prøvede jeg, men det virker ikke og så fryser den i ca. 20 sek når den kommer til at skulle åbne processen, hvilket den ikke gør når processen åbnes via Run i windows.

*skummelt* får du nogen fejlmeddelse tilbage fra:
ret = WaitForSingleObject(proc.hProcess, INFINITE)

Hvad siger ret?

hej jeg har fundet problemet som jeg ikke lige ved hvordan jeg skal løse.

Først er jeg nødt til at sikre mig at Acrobat pro og acrobat reader er helt lukket ned. Hvis man laver pdf'er med adobe i vba kan du godt åbne og lukke programmet med følgende kode:

Dim AcroExchApp As Acrobat.CAcroApp

en masse kode der laver dokumenterne

og så til sidst:

AcroExchApp.Exit

Men selvom jeg gør det så kan jeg i min task manager se under processes at Acrobat.exe stadigvæk kører. Det kan jeg dog håndtere ved at bruge følgende kode:

Call Shell("taskkill /F /IM Acrobat.exe", vbHide)
Call Shell("taskkill /F /IM AcroRd32.exe", vbHide)


Derefter virker dette:

execmd = "C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe /p /h " & Sti_Til_PDF_Fil

ExecuteAndWait execmd

Men nu kommer det sjove for nu ligger problemet et andet sted. nemlig i ExecuteAndWait da den command line jeg sender med over åbner og udskriver. Men ligesom før efterlader Acrobat.exe eller AcroRd32.exe kørende under processer efter udskrivningen. DVS. at WaitForSingleObject ikke kan blive færdig da den jo stadigvæk er åben :-( Mit bedste bud er naturligvis at bruge denne handling:

For varloop = 1 To 15000
    DoEvents
Next varloop


I håb om at den er blevet færdig med at udskrive før jeg igen dræber programmet med:

Call Shell("taskkill /F /IM AcroRd32.exe", vbHide)

hvilket gør at koden kører videre.

Det er dog langt fra hensigtsmæssigt at jeg ikke kan være sikker på at alt er sendt til printere med mindre jeg sætte tiden voldsomt op på min doevent. Systemet jeg sidder med skal printe ca. 2000 rapporter ud i forskellig størrelser og der er en katastrofe hvis ikke alt blive udskrevet :-( Så hvis ikke nogen kan hjælpe med en måde at sikre at alt er sendt til printere før jeg dræber AcroRd32.exe så må jeg have fat i Adobe og spørge dem.

Pokkers... Adobe har det med at hænge i systemet.

Men prøv lige at se denne kode: http://www.tech-archive.net/Archive/Windows/microsoft.public.windows.server.scripting/2008-04/msg00232.html

Det er Function FoundDocumentPrintJob(strPrintJobDocument) nederst der er interessant. Sammen med objWMIService burde du kunne styre printerkøen også selvom andre printer ud.

Så kan sikkert også helt undgå WaitForSingleObject()

Hej igen, jeg har også haft denne tråd ude hos andre med ekspert viden, så derfor får du/i(dvs. andre interesseret) svaret på min løsning på engelsk:

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

Hejsa :-) Det er bare ok og ser rigtigt ud.

Husk at lukke spørgsmålet.

Hej jape44, du har helt klart fortjent de point, for den indsats du har levet i forbindelse med dette problem så smid du bare et svar.

Jamen jeg takker så meget :-)