VBA-Makro für 2 Sekunden anhalten

Moderator: ModerationP

VBA-Makro für 2 Sekunden anhalten

Beitragvon RTausD » 24. Jul 2021, 15:01

Hallo allerseits,

ich habe ein Makro (s.u.), das die PDF-Dateianhänge ausgewählter eMails ausdruckt.
Grundsätzlich funktioniert das gut.
Wenn ich allerdings mehrere eMails ausgewählt habe, kommt es zu Fehlern (Adobe meldet, dass die Datei nicht geöffnet werden kann) wenn das Makro die nächsten Befehle abarbeitet.
Wenn ich eine Stop nach dem Druckbefehl setze und nach 2 oder 3 Sekunden mit F5 fortsetze (wenn der Druckjob an den Drucker übergebene wurde), funktioniert alles einwandfrei. Wenn ich allerdings schon nach 1 Sekunde die F5-Taste betätige, gibt es wieder das Problem.

Ich hatte schon eine While/Wend-Schleife eingebaut, die 3 Sekunden läuft. Das ist aber auch schon zu viel.

Hat jemand eine Idee, was man machen kann?

Vielen Dank in Voraus

Rolf

Code: Alles auswählen
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub PDF_Anhang_to_TXT()
    Temppfad = "T:\Müll\"
    Dim aktuelle_eMail As MailItem
    Dim Anzahl_Dateianhänge As Integer
    Set Auswahl = Application.ActiveExplorer.Selection
    For Each aktuelle_eMail In Auswahl
        Anzahl_Dateianhänge = aktuelle_eMail.Attachments.Count
        If Anzahl_Dateianhänge > 0 Then
            For Z = Anzahl_Dateianhänge To 1 Step -1
                Datei = aktuelle_eMail.Attachments.Item(Z).FileName
                If Format(Right(aktuelle_eMail.Attachments.Item(Z).FileName, 3), ">") = "PDF" Then
                    Ziel = Temppfad & Datei
                    aktuelle_eMail.Attachments.Item(Z).SaveAsFile Ziel
                    ShellExecute 0, "print", Ziel, vbNullString, vbNullString, 0
                    On Error Resume Next
                    Kill Ziel
                    On Error GoTo 0
               End If
            Next Z
        End If
    Next
End Sub
RTausD
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 280
Registriert: 24. Feb 2007, 10:51

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon Der Steuerfuzzi » 24. Jul 2021, 15:06

Hallo,

dafür gibt es WAIT und SLEEP: https://www.exceltrick.com/formulas_mac ... functions/

Bei dir wäre das dann SLEEP(2000) für 2 Sekunden.
Viele Grüße
Michael
Benutzeravatar
Der Steuerfuzzi
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3918
Registriert: 25. Mär 2013, 13:28


Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon RTausD » 24. Jul 2021, 19:47

Vielen Dank für die Tipps.
Leider klappt es noch nicht. Das makro wird sofort fortgesetzt und dadurch bringt der Adobe Acrobat Reader den Fehler, dass er die Datei nicht findet.

So habe ich das Makro derzeit:

Code: Alles auswählen
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Function Wait(ByVal mSek As Long)
    WaitForSingleObject -1, mSek
End Function

Sub PDF_Anhang_to_TXT()
    Dim aktuelle_eMail As MailItem
    Dim Anzahl_Dateianhänge As Integer
    Set Auswahl = Application.ActiveExplorer.Selection
    Temppfad = "T:\Temp\"
    For Each aktuelle_eMail In Auswahl
        Anzahl_Dateianhänge = aktuelle_eMail.Attachments.Count
        If Anzahl_Dateianhänge > 0 Then
            For Z = 1 To Anzahl_Dateianhänge
                If Format(Right(aktuelle_eMail.Attachments.Item(Z).FileName, 3), ">") = "PDF" Then
                    Ziel = Temppfad & "Test " & aktuelle_eMail.Attachments.Item(Z).FileName
                    aktuelle_eMail.Attachments.Item(Z).SaveAsFile Ziel
                    ShellExecute 0, "print", Ziel, vbNullString, vbNullString, 0
                    Wait 10000
                    Anzahl = Anzahl + 1
                End If
            Next Z
        End If
    Next
    If Anzahl > 0 Then MsgBox "Es wurden " & Anzahl & " PDfs gedruckt.", 0, "Druck PDFs aus markierten eMails"
End Sub


Wenn ich Unload me drin lasse, bringt das Excel eine Fehlermeldung.

Hat jemand eine Idee, was ich ändern muss?

Vielen Dank im Voraus

Rolf
RTausD
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 280
Registriert: 24. Feb 2007, 10:51

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon Der Steuerfuzzi » 24. Jul 2021, 20:48

Hallo,

WAIT wartet bis zu einem bestimmten Zeitpunkt (Uhrzeit) und nicht einen bestimmten Zeitraum. Du musst WAIT für 2 Sekunden warten so benutzen:
Code: Alles auswählen
Application.Wait (Now + TimeValue("0:00:02"))


SLEEP ist eine Windows-Api-Funktion (siehe mein Link).
Viele Grüße
Michael
Benutzeravatar
Der Steuerfuzzi
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3918
Registriert: 25. Mär 2013, 13:28

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon mmarkus » 24. Jul 2021, 21:22

Das Problem ist, dass du versucht die PDF Datei zu löschen während der Druck noch nicht abgeschlossen ist, da der Code nicht wartet bis der Druck abgeschlossen ist.

Ein Timer hat natürlich immer das Problem, dass verschiedene Umstände das rein spielen können.
Größe der Datei - Auslastung des PC, Druckers oder was auch immer.
Es sollte also immer berücksichtigt werden, dass der Timer möglicherweise zu kurz ist.
Eine Möglichkeit wäre die Dateien einfach in einem Ordner bis zum nächsten Drucken gespeichert zu lassen und vor dem nächsten Druck alle Datei en des Ordner zu löschen.

Die Freigabe der Datei kann man prüfen indem man versucht die Datei mittels der open Methode in einem exklusiven Modus zu öffnen ohne etwas auszulesen.
ms access what else
mmarkus
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 2142
Registriert: 16. Apr 2012, 16:07
Wohnort: Oberösterreich

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon Der Steuerfuzzi » 25. Jul 2021, 16:46

Verwende doch den Windows Scripting Host statt ShellExecute (siehe https://www.herber.de/forum/archiv/912to916/915294_externes_Programm_starten_und_auf_Ausgabe_warten.html):
Code: Alles auswählen
Sub b()
  Set WshShell = CreateObject("WScript.Shell")
  WshShell.Run "dein Programm", 1, True
End Sub

Das wartet auf das Ende des aufgerufenen Programms.
Viele Grüße
Michael
Benutzeravatar
Der Steuerfuzzi
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3918
Registriert: 25. Mär 2013, 13:28

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon mmarkus » 28. Jul 2021, 13:14

Der Steuerfuzzi hat geschrieben:
Code: Alles auswählen
Sub b()
  Set WshShell = CreateObject("WScript.Shell")
  WshShell.Run "dein Programm", 1, True
End Sub


Und was könnte der Code in diesem Kontext bringen?

Wie müsste der Code aussehen, um einem konkreten Programm mitzuteilen, dass es eine bestimmte Datei mit einem bestimmten Drucker drucken soll?
Kennst du dafür einen allgemein gültigen Code?

Das wäre natürlich interessant.
ms access what else
mmarkus
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 2142
Registriert: 16. Apr 2012, 16:07
Wohnort: Oberösterreich

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon knobbi38 » 28. Jul 2021, 13:50

Hallo Rolf,

für eine richtige Umsetzung müßtest du die zeitabhängige Komponente eliminieren, entweder durch ein externes Programm, welches eine entsprechende COM-Schnittselle zur Überwachung anbietet oder du überwachst per API die JobQueue des Printspoolers, ob die entsprechende Datei komplett ausgespoolt worden ist.
Danach kannst du dann gefahrlos mit der nächsten Datei weiter machen.

Gruß Ulrich
Zuletzt geändert von knobbi38 am 30. Jul 2021, 20:44, insgesamt 1-mal geändert.
knobbi38
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3456
Registriert: 02. Jul 2015, 14:23

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon Der Steuerfuzzi » 28. Jul 2021, 14:42

mmarkus hat geschrieben:Wie müsste der Code aussehen, um einem konkreten Programm mitzuteilen, dass es eine bestimmte Datei mit einem bestimmten Drucker drucken soll?
Kennst du dafür einen allgemein gültigen Code?
Wenn es sich um PDF-Dokumente handelt, so kann man diese mit diversen Tools (z. B. Ghostscript, AdobeReader, Sumatra, Foxit) über die Kommandozeile drucken.

Drucken mit Ghostscript:
https://superuser.com/questions/906575/ ... ilent-mode
https://ghostscript.com/doc/current/Devices.htm#Win

Hier gibt es noch eine Drittanbieterlösung (die zwar etwas kostet aber dafür hast Du auch Support):
https://www.biopdf.com/purchase.php

Im Netz gibt es sicher noch mehr Beispiele, wie man PDF-Dateien per Kommandozeile drucken kann.
Viele Grüße
Michael
Benutzeravatar
Der Steuerfuzzi
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3918
Registriert: 25. Mär 2013, 13:28

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon Gast » 29. Jul 2021, 12:13

@Steuerfuzzi,

für jedes Programm/Programmversion einen anderen Code - ich glaube, genau so wird man nicht wollen.

Spannender in dem Kontext wäre es so was wie bei Shell Print zu haben.

Es müsste da doch eine Schnittstelle dafür geben, weil Windows muss ja auch diese nutzen um dies dem Programm direkt mitzuteilen.
Gast
 

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon RTausD » 30. Jul 2021, 11:14

Hallo allerseits,

VIELEN DANK für all die Hinweise.

Die PDF-Datei wird später an anderer Stelle gebraucht. Daher habe jetzt das Speichern im endgültigen Verzeichnis vorgezogen und den Löschbefehl für die PDF-Datei rausgenommen.

Für alle, die es interessiert hier der komplette Code, mit dem ich eingehende Rechnungen drucke, analysiere, die eMail als bearbeitet kennzeichne und in einen anderen Ordner verschiebe. :wink:

Code: Alles auswählen
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub Eingangsrechnungen_Holland()
    Temppfad = "U:\Temp\"
    Zielpfad_Archiv = "U:\Archiv\"
    Zielpfad_RAB = "U:\RAB\"
    Modulpfad = "U:\PDFtoTXT\"
    If Dir(Modulpfad & "pdftotext.exe") = "" Then MsgBox ("Unter " & Modulpfad & " ist kein PDT-Converter gespeichert!")
    If Dir(Modulpfad & "pdftotext.exe") = "" Then Exit Sub
    Dim aktuelle_eMail As MailItem
    Dim Anzahl_Dateianhänge As Integer
    Set olNsp = Application.Application.GetNamespace("MAPI")
    Set Ordner = Application.ActiveExplorer.CurrentFolder
    Set Zielordner = olNsp.Folders.Item("r.thielmann@hg-systems.com").Folders.Item("Gelöschte Elemente").Folders.Item("Test").Folders.Item("verschoben")
    Set Auswahl = Application.ActiveExplorer.Selection
    For Each aktuelle_eMail In Auswahl
        Anzahl_Dateianhänge = aktuelle_eMail.Attachments.Count
        If Anzahl_Dateianhänge > 0 Then
            For Z = 1 To Anzahl_Dateianhänge
                If Format(Right(aktuelle_eMail.Attachments.Item(Z).FileName, 3), ">") = "PDF" Then
                    Ziel = Temppfad & "Temp " & Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hh-mm-ss") & aktuelle_eMail.Attachments.Item(Z).FileName
                    aktuelle_eMail.Attachments.Item(Z).SaveAsFile Ziel
                    TXT_Datei = Left(Ziel, Len(Ziel) - 4) & ".txt"
                    Call Funktion_GetPDFText(Ziel, Modulpfad)
                    Call Funktion_TXT_einlesen(TXT_Datei, Gesamttext)
                    Firma = Right(Gesamttext, Len(Gesamttext) - InStr(Gesamttext, Chr(10)))
                    'MsgBox (Asc(Firma))
                    While Left(Firma, 1) = " "
                        Firma = Right(Firma, Len(Firma) - InStr(Firma, Chr(10)))
                    Wend
                    Firma = Left(Firma, InStr(Firma, Chr(10)) - 1)
                    While Left(Firma, 1) = " "
                        Firma = Right(Firma, Len(Firma) - 1)
                    Wend
                    If InStr(Firma, "   ") > 0 Then Firma = Left(Firma, InStr(Firma, "   "))
                    While Right(Firma, 1) = " "
                        Firma = Left(Firma, Len(Firma) - 1)
                    Wend
                    If InStr(Gesamttext, "Rekening") > 0 Then Rechnungsnummer = Right(Gesamttext, Len(Gesamttext) - InStr(Gesamttext, "Rekening") - 7)
                    If InStr(Rechnungsnummer, Chr(10)) > 0 Then Rechnungsnummer = Left(Rechnungsnummer, InStr(Rechnungsnummer, Chr(10)) - 1)
                    If InStr(Rechnungsnummer, "_") > 0 Then Rechnungsnummer = Left(Rechnungsnummer, InStr(Rechnungsnummer, "_") - 1)
                    If InStr(Gesamttext, "Onze opdracht") > 0 Then Auftragsnummer = Right(Gesamttext, Len(Gesamttext) - InStr(Gesamttext, "Onze opdracht") - 12)
                    If InStr(Auftragsnummer, Chr(10)) > 0 Then Auftragsnummer = Left(Auftragsnummer, InStr(Auftragsnummer, Chr(10)) - 1)
                    While Left(Auftragsnummer, 1) = " "
                        Auftragsnummer = Right(Auftragsnummer, Len(Auftragsnummer) - 1)
                    Wend
                    If InStr(Gesamttext, "Fabricaat nummer") > 0 Then Maschinennummer = Right(Gesamttext, Len(Gesamttext) - InStr(Gesamttext, "Fabricaat nummer") - 15)
                    If InStr(Maschinennummer, Chr(10)) > 0 Then Maschinennummer = Left(Maschinennummer, InStr(Maschinennummer, Chr(10)) - 1)
                    While Left(Maschinennummer, 1) = " "
                        Maschinennummer = Right(Maschinennummer, Len(Maschinennummer) - 1)
                    Wend
                    On Error Resume Next
                    Kill Left(TXT_Datei, Len(TXT_Datei) - 3) & "*"
                    On Error GoTo 0
                    Ziel = Zielpfad_Archiv & "Auftrag " & Auftragsnummer & " Ausgangsrechnung " & Rechnungsnummer & " Maschine " & Maschinennummer & ".pdf"
                    aktuelle_eMail.Attachments.Item(Z).SaveAsFile Ziel
                    Ziel = Zielpfad_RAB & "Ausgangsrechnung " & Rechnungsnummer & " " & Firma & ".pdf"
                    aktuelle_eMail.Attachments.Item(Z).SaveAsFile Ziel
                    Frage = 6
'                    Frage = MsgBox("Soll die Datei " & aktuelle_eMail.Attachments.Item(Z) & " gedruckt werden?", 4, "Druck PDF")
                    If Frage = 6 Then
                        Call ShellExecute(0&, "printto", Ziel, Chr(34) & "HP LaserJet" & Chr(34), vbNullString, 0&)
                        Anzahl = Anzahl + 1
                        Rechnungsliste = Rechnungsliste & Chr(10) & Right(Ziel, Len(Ziel) - Len(Zielpfad_Archiv) + 3)  ''''''''''''''''''   prüfen  ''''''''''''
                        aktuelle_eMail.Subject = "PDF gedruckt ( " & Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hh:mm") & "h ) > " & aktuelle_eMail.Subject
                        aktuelle_eMail.Save
                    End If
                    Gesamttext = ""
                    Rechnungsnummer = ""
                    Ziel = ""
                End If
            Next Z
        End If
        aktuelle_eMail.Move Zielordner
    Next
    If Anzahl > 0 Then MsgBox "Es wurden folgende " & Anzahl & " PDfs gedruckt:" & Chr(10) & Rechnungsliste, 0, "Druck PDFs aus markierten eMails"
End Sub

Function Funktion_GetPDFText(Ziel, Modulpfad) ' As String
    If Ziel = "" Then Exit Function
    If InStr(Ziel, " ") > 1 Then Ziel = Chr(34) & Ziel & Chr(34)
    Dim objShell As Object, objExec As Object, intExitCode As Integer
    cstrPDFConverter = Modulpfad & "pdftotext.exe -layout"
    Set objShell = CreateObject("WScript.Shell")
    Set objExec = objShell.Exec(cstrPDFConverter & " " & Ziel)
    Funktion_GetPDFText = objExec.StdOut.ReadAll
    intExitCode = objExec.ExitCode
    Set objExec = Nothing
    Set objShell = Nothing
End Function

Function Funktion_TXT_einlesen(TXT_Datei, Gesamttext)
    Open TXT_Datei For Input As #1
    While Not EOF(1)
        Line Input #1, Textline
        Gesamttext = Gesamttext & Textline & Chr(10)
    Wend
    Close #1
    If InStr(TXT_Datei, "Leitblatt") = 0 Then
        If InStr(Gesamttext, "#") > 0 Then MsgBox ("ACHTUNG !!!" & Chr(10) & Chr(10) & "Im Text des PDF steht ein interner Text (eingeleitet mit #)." & Chr(10) & Chr(10) & "Bitte das Dokument noch einmal drucken und über Word (hier den internen Text entfernen) das PDF erstellen." & Chr(10) & Chr(10) & Mid(Gesamttext, InStr(Gesamttext, "#"), Len(Gesamttext) - InStr(Gesamttext, "#")))
        If InStr(Gesamttext, "1,45 Porto") > 0 Then MsgBox ("ACHTUNG !!!" & Chr(10) & Chr(10) & "Im Text des PDF steht 1,45 Porto. Das ist der Portowert für Großbriefe bis 30.06.2019." & Chr(10) & Chr(10) & "Bitte auf 1,55 Porto ändern und das PDF erneut erstellen.")
    End If
End Function


Viele Grüße

Rolf
RTausD
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 280
Registriert: 24. Feb 2007, 10:51

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon mmarkus » 30. Jul 2021, 13:29

Das Printto funktioniert also.
Was war da das Problem?

Ein Thread macht ja für künftige Leser wenig Sinn, wenn überhaupt keine Reaktion auf Lösungsvorschläge kommt.
ms access what else
mmarkus
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 2142
Registriert: 16. Apr 2012, 16:07
Wohnort: Oberösterreich

Re: VBA-Makro für 2 Sekunden anhalten

Beitragvon RTausD » 01. Aug 2021, 08:57

Das Problem war, dass die temporär gespeicherte PDF-Datei schon wieder gelöscht war, bevor der Druck vollendet war.
Nachdem das löschen nicht mehr nötig war, musste das Programm auch nicht mehr angehalten werden.
RTausD
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 280
Registriert: 24. Feb 2007, 10:51


Zurück zu Outlook Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 3 Gäste