18. september 2009 - 13:19Der er
20 kommentarer og 1 løsning
ShellExecute Print AND wait
Hej Eksperter
Jeg sidder med lidt kode hvor jeg udskriver den samme PDF x antal gange.
Problemet er at hvis den fx skal printe den første fil 4 gange så går det måske fint, men skal den så printe den næste fil 3 gange så kommer der måske kun et udprint. Jeg ved allerede hvad problemet er. Det er at printeren ikke når at modtage det første print før den sender den næste afsted. Derfor vil jeg gerne have hjælp til at sikre at printeren har modtage printet altså at min shellexecute er færdig før den sender den næste afsted.
Jeg er ligeledes interesseret i at vide om man med shellexecute kan fortælle at den skal udskrive x antal i stedet for at lave et loop og køre shellexecute funktion x antal gange for samme fil?
WaitWhileRunning lRet For varloop = 1 To 3000 DoEvents Next varloop
Public Sub WaitWhileRunning(lngHWnd As Long) Dim lngExitCode As Long Dim lnghProcess As Long
lngExitCode = STILL_ACTIVE lnghProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, lngHWnd) If lnghProcess > 0 Then Do While lngExitCode = STILL_ACTIVE Call GetExitCodeProcess(lnghProcess, lngExitCode) DoEvents Loop End If End Sub
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Sådan understøtter du en datadreven kultur, som skaber værdi i din virksomhed.
7. maj 2024
Slettet bruger
19. september 2009 - 19:00#1
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
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.
Synes godt om
Slettet bruger
21. september 2009 - 10:15#4
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
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
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.
Synes godt om
Slettet bruger
21. september 2009 - 13:06#8
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 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.
Synes godt om
Slettet bruger
21. september 2009 - 15:02#15
*skummelt* får du nogen fejlmeddelse tilbage fra: ret = WaitForSingleObject(proc.hProcess, INFINITE)
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:
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:
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.
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
' 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
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
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.
Synes godt om
Slettet bruger
08. oktober 2009 - 12:55#21
Jamen jeg takker så meget :-)
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.