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
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.
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
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.
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
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
Edit:
da wäre noch eine Frage. Öffnest Du pdf standardmäßig mit dem AdobeReader oder einem anderen pdf Reader oder mit dem Browser?
Hi Andre,
ich öffne die PDFs mit Acrobat Reader Standard.
Deine Schleife läuft unendlich weiter!? :)
LG
Alexandra
Hallöchen,
Zitat: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
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