PDF Dateien per Excel VBA drucken und als Mail Anhang versenden

[cysu11]

Hallo liebe Excelgemiende,

benötige mal wieder Eure Hilfe bei folgendes Problem:
In eine exceldatei habe ich ab Zeile 2 ins Spalte B Lieferscheinnummern und in Spalte C Rechnungsnummern immer verschiedene Anzahl. Die Lieferscheine dazu und Rechnungen sind in einen bestimmten Ordner abgelegt als PDF Dateien, mit anderen dateien. Nun möchte ich per VBA auf Knopfdruck, dass sämtliche Rechnungen und Lieferscheine die in der Exceldatei aufgeführt sind die PDF Dateien dazu, gesucht, ausgedruckt werden und anschliessend als Mailanhang versendet werden!

Ich hoffe Ihr versteht was ich meine!? ?

Vielen lieben Dank im Voraus!!
LG
Alexandra

[schauan]

Hallo Alexandra,

ich will ja nicht unhöflich sein, aber hast Du dazu mal unsere Suche oben rechts benutzt? pdf und Anhang hatten wir schon häufig behandelt. pdf und drucken eventuell auch, da bin ich mir nicht ganz sicher.

[cysu11]

Hallo Andre,

danke für deine Antwort, ich habe natürlich die Suche genutzt und das hier mir für die Anhänge gebastelt:

Code:

Private Sub MailErzeugen()
    Wahl = MsgBox("Exportdokumente senden?", vbYesNo)
    If Wahl <> 6 Then Exit Sub
    Dim olApp As Object
    Set olApp = CreateObject("Outlook.Application")
    With olApp.CreateItem(0)
        'Empfänger
        .Recipients.Add Range("H1").Value
        .Subject = "Exportdokumente Sendung " & Range("C1").Text & ", " & Range("C2").Text & " " & Range("C4").Text & " - " & Range("C3").Text
       
        .GetInspector.display
        .ReadReceiptRequested = True
        .Attachments.Add "c:\Temp123\" & "LS" & Range("A6") & ".PDF"
        .Attachments.Add "c:\Temp123\" & "RE" & Range("C6") & ".PDF"
        If Range("F1") = "x" Then .display
        If Range("F1") <> "x" Then .Send
        '.Send
        MsgBox ("Exportdokumente zur Sendung " & Range("C1") & " wurden erfolgreich gesendet!")
    End With
    Set olApp = Nothing
End Sub

Das fügt mir die PDF Dateien mit den Namen die im A6 und C6 stehen entsprechend in eine Mail ein und versendet diese, das funktioniert! Aber wie kann ich das flexibel gestalten, daß der Code die ganzen Lieferschein und Rechnungen sucht die in der jeweiligen Spalte aufgeführt sind sucht, druckt und als Mailanhang dann versendet. Und vor allem, was wenn mal eine Datei nicht gefunden wird!? Zum Thema drucken der PDFs habe ich leider nichts gefunden!?

Kann mir jemand mit dem Code helfen?

Vielen Dank
LG
Alexandra

[schauan]

Hi Alexandra,

da muss eine Schleife drumherum oder Du hast ein Startmakro, wo Du den Mailexport mit den entsprechenden Parametern aufrufst.

Eine Schleife könnte so aussehen:

Dim iCnt%
iCnt=2 'Bei Eintraegen ab Zeile 2
'Schleife solange in A nicht nix steht, oder 8 für Spalte H und dann aber mit dem Startwert iCnt = 1
Do While Cells(iCnt, 1).Value <> ""


'Ende Schleife solange in A nicht nix steht
Loop

Dann setzt Du den Range zusammen, ich bleib jetzt mal bei "meinem" A: Range("A" & iCnt)

Mir ist jetzt nur nicht klar ob Du mehrere E-Mails an verschiedene Empfänger senden willst oder an einen Empfänger mehrere verschiedene Anhänge.

Wenn es verschiedene Empfänger sind, käme die Schleife um das With / End With außen herum. Geht's nur um mehrere Anhänge dann nur um die Zeilen mit den Anhängen.

[cysu11]

Hallo Andre,

vielen Dank für dein Antwort. Es sollen alle Rechnungen und Lieferscheine die in der Exceldatei aufgeführt sind an einen Empfänger versendet werden!

Könntest du mir evtl. den ganzen Code für eine Spalte mal schreiben mit finden der Dateien, Drucken und Versenden, ich würde Ihn dann für die anderen Spalten erweitern und anpassen!?
Wärst du so nett? Ich war schon mal etwas tiefer drin im Excel VBA aber seit über 1 Jahr leider nichts mehr damit gemacht und leider entsprechend alles wieder verlernt! :(
Für Dich ist es wahrscheinlich ein Klacks!

Wäre wirklich sehr dankbar!

LG
Alexandra

[schauan]

Hi Alexandra,

hier erst mal der Teil mit den Anhängen, kannst mal schauen, ob das so passt.

Code:

Option Explicit

Private Sub MailErzeugen()
    Wahl = MsgBox("Exportdokumente senden?", vbYesNo)
    If Wahl <> 6 Then Exit Sub
    Dim olApp As Object
    Dim iCnt% 'Schleifenzaehler
    Set olApp = CreateObject("Outlook.Application")
    With olApp.CreateItem(0)
        'Empfänger
        .Recipients.Add Range("H1").Value
        .Subject = "Exportdokumente Sendung " & Range("C1").Text & ", " & Range("C2").Text & " " & Range("C4").Text & " - " & Range("C3").Text
        .GetInspector.display
        .ReadReceiptRequested = True
        iCnt = 6 'Bei Eintraegen ab Zeile 6
        'Schleife solange in A nicht nix steht
        Do While Cells(iCnt, 1).Value <> ""
          'wenn Datei vorhanden, dann
          If Dir("c:\Temp123\LS" & Range("A" & iCnt) & ".PDF") <> "" Then
            'Anhang hinzufuegen
            .Attachments.Add "c:\Temp123\LS" & Range("A" & iCnt) & ".PDF"
          'Ende wenn Datei vorhanden, dann
          End If
          'wenn Datei vorhanden, dann
          If Dir("c:\Temp123\RE" & Range("C" & iCnt) & ".PDF") <> "" Then
            'Anhang hinzufuegen
            .Attachments.Add "c:\Temp123\RE" & Range("C" & iCnt) & ".PDF"
          'Ende wenn Datei vorhanden, dann
          End If
        'Ende Schleife solange in A nicht nix steht
        Loop
        If Range("F1") = "x" Then .display
        If Range("F1") <> "x" Then .Send
        '.Send
        MsgBox ("Exportdokumente zur Sendung " & Range("C1") & " wurden erfolgreich gesendet!")
    End With
    Set olA

[schauan]

Edit:

da wäre noch eine Frage. Öffnest Du pdf standardmäßig mit dem AdobeReader oder einem anderen pdf Reader oder mit dem Browser?

[cysu11]

Hi Andre,

ich öffne die PDFs mit Acrobat Reader Standard.

Deine Schleife läuft unendlich weiter!? :)

LG
Alexandra

[schauan]

Hallöchen,

Deine Schleife läuft unendlich weiter!?

peinlich, peinlich
da fehlt vor dem Loop noch ein iCnt=iCnt+1 und am Ende ist auch noch was abgerutscht

Mit Druck sieht es so aus. Hab den Druck aber nur extra getestet und nicht hier im Makro

Code:

Option Explicit

'API fuer Anwendungsaufruf
Private Declare 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
        
Private Sub MailErzeugen()
    Wahl = MsgBox("Exportdokumente senden?", vbYesNo)
    If Wahl <> 6 Then Exit Sub
    Dim olApp As Object
    Dim iCnt% 'Schleifenzaehler
    Dim strFile$ 'Dateiname
    Set olApp = CreateObject("Outlook.Application")
    With olApp.CreateItem(0)
        'Empfänger
        .Recipients.Add Range("H1").Value
        .Subject = "Exportdokumente Sendung " & Range("C1").Text & ", " & Range("C2").Text & " " & Range("C4").Text & " - " & Range("C3").Text
        .GetInspector.display
        .ReadReceiptRequested = True
        iCnt = 6 'Bei Eintraegen ab Zeile 6
        'Schleife solange in A nicht nix steht
        Do While Cells(iCnt, 1).Value <> ""
          'dateiname 1
          strFile = "c:\Temp123\LS" & Range("A" & iCnt) & ".PDF"
          'wenn Datei vorhanden, dann
          If Dir(strFile) <> "" Then
            'Anhang hinzufuegen
            .Attachments.Add strFile
            'Drucken
            ShellExecute 0, "print", strFile, "", "", 0
          'Ende wenn Datei vorhanden, dann
          End If
          'dateiname 2
          strFile = "c:\Temp123\RE" & Range("C" & iCnt) & ".PDF"
          'wenn Datei vorhanden, dann
          If Dir(strFile) <> "" Then
            'Anhang hinzufuegen
            .Attachments.Add strFile
            'Drucken
            ShellExecute 0, "print", strFile, "", "", 0
          'Ende wenn Datei vorhanden, dann
          End If
        'Schleifenzaehler hochsetzen
        iCnt = iCnt + 1
        'Ende Schleife solange in A nicht nix steht
        Loop
        If Range("F1") = "x" Then .display
        If Range("F1") <> "x" Then .Send
        '.Send
        MsgBox ("Exportdokumente zur Sendung " & Range("C1") & " wurden erfolgreich gesendet!")
    End With
    Set olApp = Nothing
End Sub

[cysu11]

Hallo Andre, 

vielen Dank schon mal, sieht schon sehr gut aus! Ich werde morgen versuchen den Code auf all meine Bedürfnisse anzupassen und melde mich dann wieder!

Aufgefallen ist mir beim Testen, dass die PDF gedruckt werden aber der Acrobat Reader nach dem Drucken offen bleibt? Kann man das ändern, AR nach dem Drucken geschlossen wird? Und eine zweite Frage, der Code orientiert sich nach Spalte A, wenn jetzt aber in Spate A nur zwei Lieferscheine stehen und in Spate C 3 oder mehr dann hört der Code nach der zweiten Rechnungsnummer auf?

Vielen lieben Dank bisher!
LG
Alexandra