Ich möchte mehrere individuelle PDF-Dateien mit persönlichem Anschreibe-Text und Betreff an persönliche Email Adressen zunächst einmal als Entwurf mittels VBA Ereignisprozedur in einem Private Sub per Button-Click erstellen. Der persönliche Anschreibetext soll aus einem bereits vorliegenden Serien-Bericht als Email Text übernommen werden. Im Internet bin ich auf folgende Prozedur gestoßen, die ich etwas abgewandelt verwendet habe. Leider kommt folgende Fehlermeldung: Benutzerdefinierter Typ nicht definiert!
Kann mir jemand wieder helfen?
Viele Grüße ToBu
Hier die verwendete Prozedur:
Private Sub Befehl63_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim emailTo As String
Dim emailSubject As String
Dim emailText As String
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
Set outApp = CreateObject("Outlook.Application")
outlookStarted = True
End If
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT MitglNr, Anrede, NameMitarbeiter, PersEmail " & _
" FROM EmailVersandDaten")
Do Until rs.EOF
emailTo = Trim(rs.Fields("MitglNr").Value & "_" & rs.Fields("NameMitarbeiter").Value) & _
" <" & rs.Fields("PersEmail").Value & ">"
emailSubject = "Aktuelle Ergebnisse Marktstatistiken Konfektion Tücher bzw. Markisengestelle"
'strSQL = "Serienbericht(MitglNr)"
emailText = strSQL
Set outMail = outApp.CreateItem(olMailItem)
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Send
Stop
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
If outlookStarted Then
outApp.Quit
End If
Set outMail = Nothing
Set outApp = Nothing
End Sub
Entweder ist Outlook nicht installiert oder der Verweis auf die Outlook-Library nicht gesetzt.
Hallo Franz,
ich habe übersehen, dass das Häkchen nicht gesetzt war und dieses nun entsprechend gesetzt. Jetzt funktioniert es tatsächlich! Vielen Dank!
Die Email Adressen werden richtig übergeben, der Betreff ebenso. aber wie bekomme ich den Inhalt des Serienberichts in den Text?
Mir fehlt wieder einmal die VBA Syntax zur Übergabe mit Kriterium MitglNr. Geht das über DoCmd.Report oder strSQL?
Besten Dank für deine Hilfe!
Gruß ToBu
Hallo Franz,
ich komme noch einmal auf die Variabilisierung von Emails zurück.
1. Frage: Wie lautet die Anweisung, wenn man die Emails nicht direkt versenden will, sondern stattdessen diese in den Ordner "Entwürfe" speichern möchte, damit man noch einmal überprüfen kann, ob alles richtig funktioniert.
Statt outMail.send
outMail.?
2. Frage: Wie kann man den Inhalt von Berichten in outMail.Body = hineinbekommen?
Habe folgendes Modul dazu:
Private Sub Befehl63_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim emailTo As String
Dim emailSubject As String
Dim emailText As String
Dim Anrede As String
Dim NameMitarbeiter As String
Dim Berichtszeit As String
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
Set outApp = CreateObject("Outlook.Application")
outlookStarted = True
End If
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT MitglNr, Anrede, NameMitarbeiter, PersEmail, Berichtszeit" & _
" FROM EmailVersandDaten")
Do Until rs.EOF
'If MitglNr <> 101 Then
emailTo = Trim(rs.Fields("MitglNr").Value & "_" & rs.Fields("NameMitarbeiter").Value) & _
" <" & rs.Fields("PersEmail").Value & ">"
emailSubject = "Aktuelle Ergebnisse Marktstatistiken Konfektion Tücher bzw. Markisengestelle"
emailText = Trim(rs.Fields("Anrede").Value & " " & rs.Fields("NameMitarbeiter").Value & "," & vbCrLf & vbCrLf & "in beigefügter Anlage finden Sie die Auswertungen o.a. Erhebungen für den Berichtszeitraum" & vbCrLf & rs.Fields("Berichtszeit").Value & "." & vbCrLf & "Für Fragen stehen wir Ihnen weiterhin gerne zur Verfügung und verbleiben" & vbCrLf & vbCrLf & "mit freundlichen Grüßen aus Moers" & vbCrLf & vbCrLf & "Thomas Buchholtz" & vbCrLf & "MobilNr: 0179-935 22 69")
'emailText = DoCmd.OpenReport("Persönliche EmailAnschreiben mit Repräsentanz M_K_", acViewPreview)
Set outMail = outApp.CreateItem(olMailItem)
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Send
Stop
'Else
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
Vielen Dank für deine Hilfe!
Gruß ToBu
Lösung zur 1. Frage: OutMail.Display
OutMail.Save
Damit werden die Emails in Entwürfe abgelegt. Dort kann man alles überprüfen, verändern, Anhänge hinzufügen etc.
Lösung zur 2. Frage: Offenbar sind Berichte hochkomplex und können nicht ohne weiteres in den OutMail.Body transferiert werden! Ich habe mir nach Recherchen damit beholfen, dass ich die den Berichten zugrunde liegenden Abfragen mittels Recordsets über Do until EOF sequenziell abarbeite (im Loop). Die einzelnen Datensätze der Abfragen werden wiederum in Schleifen an definierte Variablen hintereinander gereiht, die dann nach Loop Ende dem OutMail.Body übergeben werden.
Gruß ToBu
Hallo,
Zitatkönnen nicht ohne weiteres in den OutMail.Body transferiert werden!
so ist es...
Alternativen (zur Step by Step Zusammensetzung von Text):
--Export des Berichtes in eine html-Datei und einkopieren in die HTMLBody- Eigenschaft ( nicht Body) des Mail-Objektes.
-- Export des Berichtes als separate Datei (html, pdf) und Anhängen als Attachment an die Mail.
Hallo Franz,
vielen Dank für den Hinweis! Aber ich möchte ja gerade nicht den Bericht als Anhang, sondern im Email-Text versenden. Es handelt sich um persönliche Anschreiben, die automatisch generiert in Entwürfe gespeichert werden sollen. Im Step by Step werden bei mir 3 Abfrageergebnisse im Body erstellt. Das funktioniert recht gut, ist für meinen Bedarf auch relativ schnell.
Meine noch echte Herausforderung ist nach wie vor, den persönlichen Emails noch verschiedene persönliche Anhänge in PDF-Form programmatisch hinzuzufügen. Da komme ich leider nicht weiter.
Könntest Du mir auch in diesem Punkt wieder weiterhelfen?
Vielen Dank!
Gruß ToBu
Hallo,
dann verwende doch die erste Alternative (aus meinem letzten Post)...
Statt Plain-Text wird eben HTML-Format benutzt.
Hallo Franz,
leider verstehe ich zu wenig von HTML Formaten und Body-Eigenschaften. Ich möchte auch nicht "händisch" individuelle PDFs kopieren müssen.
Ich möchte dagegen innerhalb einer Schleife nur die persönlichen PDFs anhand eines String Kriteriums (z.B. "101" & "*" für eine MitgliedsNr) aus einem Pfad/Ordner sequenziell auslesen und als Anhang zur Email an 101 automatisch anfügen und im Entwurf abspeichern. Dann sollte die nächste MitgliedsNr abgearbeitet werden usw. Meine VBA Kenntnisse sind noch viel zu gering, um die Syntax auch wirklich zu verstehen. Aber man ist ja lernfähig! Dauert nur ein bisschen länger bei mir! Was muss ich noch an unten stehender Programmierung ändern, damit die gefundenen persönlichen PDFs entsprechen im Anhang landen?
Besten Dank!!
'....
strFolder = Pfad_Ordner
Set oApp = CreateObject("Outlook.Application")
Do Until rs3.EOF
'With oApp.CreateItem(0)
'strFilename = Dir(strFolder & "101" & "*")
'Call .Attachments.Add(strFolder & strFilename)
'strFilename = Dir
'Loop
'End With
'Set oApp = Nothing
rs3.MoveNext
Loop
Set outMail = outApp.CreateItem(olMailItem)
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Display
outMail.Save
Hallo,
durchlaufe den entsprechenden Folder und füge jede gefundene PDF-Datei als Attachment an:
(Luftcode)
.
.
.
strFolder = Pfad_Ordner 'c:\MeinVerzeichnis
Set oApp = CreateObject("Outlook.Application")
Set outMail = oApp.CreateItem(olMailItem)
Do Until rs3.EOF
strFilename = Dir(strFolder & "\" & rs3!Mitgliedsnummer & "*.PDF")
Do until strFilename =""
outMail.Attachments.Add(strFolder & "\" & strFilename)
strFilename = Dir(strFolder & "\" & rs3!Mitgliedsnummer & "*.PDF")
Loop
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Display
outMail.Save
rs3.Movenext
Loop
.
.
Hallo Franz,
vielen Dank für Deinen Code! Ich werde gleich noch versuchen, diesen in das Modul umzusetzen.
Hoffentlich klappt das! Ich gebe später Bescheid.
Gruß ToBu.
Hallo Franz,
leider kommt es zu einem Laufzeitfehler 91: Objektvariable oder with-Blockvariable nicht festgelegt!
Ich habe Deinen Code geringfügig modifiziert, da bei mir im String Pfad_Ordner bereits am Ende schon der "\" gesetzt ist.
Muss dieser String eingangs als allgemeingültig definiert werden oder reicht tatsächlich bei allen nachfolgenden Anweisungen und Definitionen einfach
Dim Pfad_Ordner as String?
Vielen Dank für Deine Mühen!
Gruß ToBu
Hier noch mein aktueller Stand des Moduls:
Private Sub Befehl63_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset
Dim strFolder As String, strFilename As String
Dim oApp As Object
Dim sAusgKonfektion As String
Dim sAusgMarkisengestelle As String
Dim emailTo As String
Dim emailSubject As String
Dim emailText As String
Dim Anrede As String
Dim NameMitarbeiter As String
Dim Berichtszeit As String
Dim Pfad_Ordner As String
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
Set outApp = CreateObject("Outlook.Application")
outlookStarted = True
End If
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT MitglNr, Anrede, NameMitarbeiter, PersEmail, Berichtszeit, Pfad_Ordner" & _
" FROM EmailVersandDaten")
Set rs1 = db.OpenRecordset("SELECT Adresse" & _
" FROM Konfektions_Teilnehmer")
Set rs2 = db.OpenRecordset("SELECT Adresse" & _
" FROM Markisengestelle_Teilnehmer")
Do Until rs.EOF
Do Until rs1.EOF
sAusgKonfektion = sAusgKonfektion & vbCrLf & rs1("Adresse")
rs1.MoveNext
Loop
Do Until rs2.EOF
sAusgMarkisengestelle = sAusgMarkisengestelle & vbCrLf & rs2("Adresse")
rs2.MoveNext
Loop
emailTo = Trim(rs.Fields("MitglNr").Value & "_" & rs.Fields("NameMitarbeiter").Value) & _
" <" & rs.Fields("PersEmail").Value & ">"
emailSubject = "Aktuelle Ergebnisse Marktstatistiken Konfektion Tücher bzw. Markisengestelle"
emailText = Trim(rs.Fields("Anrede").Value & " " & rs.Fields("NameMitarbeiter").Value & "," & _
vbCrLf & vbCrLf & "in beigefügter Anlage finden Sie die Auswertungen o.a. Erhebungen für den Berichtszeitraum
" & rs.Fields("Berichtszeit").Value & "." & vbCrLf & "Die Repräsentanz der nachstehend aufgeführten
Unternehmen ist in den " _
& "Vergleichszeiträumen der Statistiken weiterhin unverändert geblieben." & vbCrLf & _
"Für Fragen stehen wir Ihnen weiterhin gerne zur Verfügung und verbleiben" & vbCrLf & vbCrLf & _
"mit freundlichen Grüßen..." & vbCrLf & vbCrLf & "ToBu" & vbCrLf & "MobilNr: ........") & vbCrLf & vbCrLf &
"Teilnehmer Konfektion" & sAusgKonfektion & vbCrLf & vbCrLf & "Teilnehmer Markisengestelle" _
& sAusgMarkisengestelle & vbCrLf & rs.Fields("Pfad_Ordner").Value
strFolder = Pfad_Ordner 'D:\MeinVerzeichnis\
Set oApp = CreateObject("Outlook.Application")
Set outMail = oApp.CreateItem(olMailItem)
>>> Do Until rs3.EOF <<< hier debuggt das System mit Laufzeitfehler 91, gelb hinterlegt
strFilename = Dir(strFolder & rs3!MitglNr & "*.PDF")
Do Until strFilename = ""
outMail.Attachments.Add (strFolder & strFilename)
strFilename = Dir(strFolder & rs3!MitgliedNr & "*.PDF")
Loop
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Display
outMail.Save
rs3.MoveNext
Loop
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
If outlookStarted Then
outApp.Quit
End If
Set outMail = Nothing
Set outApp = Nothing
End Sub
Hallo,,
naja,Du kannst ja den "Luftcode" nicht ohne Anpassungen an die Vorgeschichte des Prozedur-Codes einfach einkopieren.
Schreibe also die Definitionen der Mail-Objekte vor die Stelle der ersten Verwendung, ebenfalls definiere die Recordset-Variablen korrekt.
Anschließend liest Du den Code von oben nach unten zeilenweise durch und tust so, als wärst Du die CPU, die die Befehle ausführen soll.
Setze dazu einen Haltepunkt an den Anfang der Prozedur und fahre den Code mit F8 (Einzelschritt) zeilenweise durch. Vergleiche/prüfe bei jedem Schritt den Inhalt der Variablen.
Zudem sollte (muss!)in jedem Modulkopf Option Explicit stehen. Hole das nach, wenn es fehlt und kompiliere den Code unter "Debuggen/Kompilieren"
Danke Franz,
ich bin nicht wirklich fit in all den VBA-Begriffen und versuche, soviel wie möglich nachzuvollziehen!
Wie Du zutreffend erkannt hast, habe ich bisher i.o Modul sr3 nicht definiert. Alles läuft richtig ab, was sr,sr1 und sr2 betrifft! Alle Datensätze der 2 Abfragen werden richtig in den Email-Text übernommen. Es geht also "nur" noch um die zuzuordnenden PDF-Anhänge mittels sr3-Schleife.
Leider fehlt mir wieder die richtige Syntax:
Wie lautet die Definition für sr3 (as Recordset oder as Objectset oder ...)?
Der Pfad mit dem aktuell letzten Ordner, in dem sich alle PDFs mit 3-stelliger BetriebsNr. > String (Pfad_Ordner, 1,3) und dahinter verschiedenem Text lautez Pfad_Ordner. Alle PDFs mit gleicher BetriebsNr. sollen aus diesem Ordner in einer Routine (sr3) - und nur diese - ausgelesen und in die aktuelle Email (sr) gebracht werden. Dann der nächste Datensatz (sr) usw.
Pfad_Ordner-String ist richtig übernommen worden.
Danke nochmals für Deinw Hilfe!
Gruß ToBu
Hallo,
vermutlich so:
rs3 entfällt, weil "MitglNr" in Recordset "rs zu finden ist.
strFolder wird durch "Pfad_Ordner" ersetzt
Zitat.
.
.
Set oApp = CreateObject("Outlook.Application")
Set outMail = oApp.CreateItem(olMailItem)
strFilename = Dir(Pfad_Ordner & rs!MitglNr & "*.PDF")
Do Until strFilename = ""
outMail.Attachments.Add (Pfad_Ordner & strFilename)
strFilename = Dir(Pfad_Ordner & rs!MitglNr & "*.PDF")
Loop
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Display
outMail.Save
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
.
.
.
.
Danke Franz,
es kommt leider eine Fehlermeldung "Element nicht gefunden!". Wahrscheinlich liegt das daran, dass MitgliedNr numerisch definiert ist as Long und im PDF-Namen die ersten 3 Ziffern ja alphanumerisch sind. Wie kann ich für diesen Grund die MitgliedNr in einen String konvertieren, so dass eine Übereinstimmung gefunden werden kann? Kann man die MitgliedNr as String definieren, obwohl in dem rs- Record MitgliedNr in numerischer Form übergeben wird?
Bin wieder ratlos!
Danke für Deine Geduld!
Gruß ToBu
Hallo,
Du interpretierst die Fehlermeldung falsch.
Sie sagt aus, dass eine Variable, bzw. Tabelle/Recordsetfeld nicht existiert.
Du solltest mitteilen, wo die Fehlermeldung auftritt und welche Codestelle markiert wird.
Hier (wenn es sich um dieses Feld dreht):
Set rs = db.OpenRecordset("SELECT MitglNr, Anrede, NameMitarbeiter, PersEmail, Berichtszeit, Pfad_Ordner" & _
" FROM EmailVersandDaten")
wird das Feld "MitglNr" selektiert und später für den Dateinamen benutzt:
strFilename = Dir(Pfad_Ordner & rs!MitglNr & "*.PDF")
Auch wenn rs!MitglNr vom Datentyp Zahl/Long ist, geschieht hier eine interne Konvertierung der numerischen Zahl in Ziffern (Text, String).
Das Sternchen sorgt dafür, dass auch Dateien gefunden werden, die zwischen der Mitgliednummer und der .PDF-Endung irgendwelche Zeichen enthalten.
Wenn das nicht gewünscht ist, dann entferne (überall) einfach dieses Sternchen.
ZitatAlle PDFs mit gleicher BetriebsNr. sollen aus diesem Ordner in einer Routine (sr3) - und nur diese - ausgelesen
Hier ist von
Betriebsnummer und nicht von
Mitgliedsnummer gesprochen. Dieses Feld ist nicht in den Recordsets enthalten. Wo also kommt dieses her?
Sehe aber gerade noch ein Durcheinander:
lösche die markierte rote Zeile und ändere in die blaue Markierung:
.
.
.
.
strFolder = Pfad_Ordner 'D:\MeinVerzeichnis\
Set oApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(olMailItem)
.
.
.
.
Und nochmal: Kompiliere den Code, setze einen Haltepunkt und fahre mit Einzelschritt durch die Codezeilen.
Prüfe jedes Mal den Inhalt der Variablen, bzw. Recordset-Felder.
(Option Explicit nicht vergessen!)
Hallo Franz,
bis zum Stop im u.a. Modulauszug läuft alles richtig!
In der MsgBox werden Pfad und Ordner korrekt ausgegeben mit allen dazugehörigen \s.
Die ersten 3 Zeichen des strFilename beinhalten korrekt die MitglNr
Im nächsten Step des Moduls kommt der Stop.
Weiter mit der F8-Taste kommt die Fehlermeldung "Wert in der Liste nicht gefunden!",
sicher weil sr.MitgliedNr im strFilename nicht gefunden wurde,
obwohl im Schritt zuvor der strFilename korrekt ausgegeben worden ist.
Danke Dir!
Gruß ToBu
Hier der Auszug:
Set oApp = CreateObject("Outlook.Application")
Set outMail = oApp.CreateItem(olMailItem)
>>>>>> strFilename = Dir(rs!Pfad_Ordner & rs!MitglNr & "*.PDF") <<<<<< ist korrekt besetzt!!!
Do Until strFilename = ""
outMail.Attachments.Add (rs!Pfad_Ordner & strFilename)
MsgBox rs!Pfad_Ordner & strFilename
>>>>>> Stop bis hier läuft alles korrekt!
strFilename = Dir(rs!Pfad_Ordner & rs!MitgliedNr & "*.PDF") <<<<<< rs!MitgliedNr ist der Fehler!!!
Loop
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Display
outMail.Save
P.S.: Option Explizit habe ich vergebens setzen wollen nach meinem Sub click 63().
Wie geht das in einem bestehenden Modul?
Wiedermal habe ich keine Ahnung!
Hallo Franz,
Entschuldigung, ich habe statt MitglNr MitgliedNr geschrieben! Das ist natürlich ein Fehler von mir! Mann wird wohl alt! Gott sei's gedankt!
Mit dem Do until Loop hapert es allerdings noch! Habe diesen mal weggelassen. Dann klappt es für alle Mitglieder Datensätze (rs), allerdings werden dann ausschließlich die ersten PDFs als Anhang richtig dem persönlichen Text zugeordnet und im Entwürfe-Ordner gespeichert. Es werden offensichtlich alle weiteren PDFs mit derselben MitglNr nicht abgearbeitet. Ließe sich das nicht mit einer For .., Next Schleife bewerkstelligen oder Do until EOF, innerhalb deren eine If ... Then Abfrage den Str(strFilename,1,3) vergleicht mit MitglNr?
Vielen Dank nochmal an dieser Stelle für Deine kompetente Unterstützung!
Gruß ToBu
Set oApp = CreateObject("Outlook.Application")
Set outMail = oApp.CreateItem(olMailItem)
strFilename = Dir(rs!Pfad_Ordner & rs!MitglNr & "*.PDF")
'Do Until strFilename = ""
outMail.Attachments.Add (rs!Pfad_Ordner & strFilename)
strFilename = Dir(rs!Pfad_Ordner & rs!MitglNr & "*.PDF")
'Loop
Hallo,
scheib mal so:
.
.
.
strFilename = Dir(rs!Pfad_Ordner & rs!MitglNr & "*.PDF")
Do Until strFilename = ""
outMail.Attachments.Add (rs!Pfad_Ordner & strFilename)
strFilename = Dir() 'Parameter weglassen
Loop
.
.
.
Nix mit If.. then.. else..
Hallo Franz,
jetzt klappt alles wie am Schnürchen!
Es ist wirklich exzellent, wie man hier in diesem Forum von so bewundernswerten Profis wie Franz u.a. begleitet, korrigiert und auf die richtige Spur gesetzt wird und dadurch ein Menge an VBA-Wissen vermittelt bekommt, auch wenn ich als Autodidakt bei weitem noch nicht alles wirklich begriffen habe, weil ich eben diese "Fremdsprache" nicht beherrsche! Aber so kommt man doch immer ein Stückchen weiter, und das macht richtig Spaß!
Vielen herzlichen Dank für so viel geduldige Unterstützung..., Franz!
Jetzt suche ich wieder vergeblich nach dem Button "Thema gelöst".
...den Button gibt's scheinbar noch nicht.