Neuigkeiten:

Wenn ihr euch für eine gute Antwort bedanken möchtet, im entsprechenden Posting einfach den Knopf "sag Danke" drücken!

Mobiles Hauptmenü

Serien Emails mit variablen Anhängen in ACCESS im Entwurf erstellen

Begonnen von ToBu, Mai 26, 2020, 14:28:12

⏪ vorheriges - nächstes ⏩

ToBu

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

DF6GL

Entweder ist Outlook nicht installiert oder der Verweis auf die Outlook-Library nicht gesetzt.

ToBu

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

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

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

DF6GL

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.





ToBu

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

DF6GL

Hallo,


dann verwende doch die erste Alternative (aus meinem letzten Post)...

Statt Plain-Text wird eben HTML-Format benutzt.



ToBu

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

DF6GL

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
.
.

ToBu

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.

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

DF6GL

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"

ToBu

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

DF6GL

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
.
.
.
.