255 Aufrufe
Gefragt in Tabellenkalkulation von peters Mitglied (494 Punkte)
Hallo zusammen,

ich habe eine Kundendatei in Excel angelegt. Sehr rudimentär und einfach.

Nun möchte ich meinen Kunden E-Mails zusenden und das Tabellenblatt mit den Kundendaten dafür nutzen.
Ich stelle mir vor, dass ich je Kunden 2 Felder nutze.
Sagen wir einmal in Spalte A die E-Mail-Adresse und Spalte B den Wert "j" für JA und "n" für NEIN
(nicht jeder möchte Newsletter bekommen).

Nun würde ich gerne eine Routine starten, die jede einzelne Zeile ausliest, bei "n" in Spalte B oder leerem Feld A weiterspringt und ansonsten dem Adressaten eine E-Mail mit einem PDF im Anhang sendet.

Einen Text für den Body der E-Mail möchte ich in einer Textdateil hinterlegen.

Und entweder soll der Text neutral gehalten werden ohne persönliche Anrede, oder die ebenfalls in der Tabelle hinterlegten Ansprechpartner genutzt werden.

Hat da jemand eine Idee zu?

Gruß

Peter

18 Antworten

0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)

Hallo Peter,

durch den Befehl LCase in der Zeile

If LCase(Cells(lngZeile, 10).Value) = "j" Then

wird der Inhalt der betreffenden Zelle in Kleinbuchstaben umgewandelt. Es ist daher egal, ob ein kleines oder ein großes J in der Zelle steht.

Öffnet er überhaupt eine E-Mail? Hast du den Verweis auf Outlook gesetzt?

Kannst du ggf. deine Datei mit ein paar Dummy-Daten mal hier hochladen?

Gruß

M.O.

0 Punkte
Beantwortet von peters Mitglied (494 Punkte)

Hallo M.O.

hier habe ich eine Beispieldatei (ich hoffe, das (hat ge-) klappt).

In den "Extras -> Verweise" habe ich alles angehakt, das mit "MS Outlook" beginnt.
Das Einstellfenster habe ich hier mal eingefügt als Bild.

Ich nutze übrigens Office Pro Plus 2010, falls das noch relevant ist.

Gruß

Peter

P.S.
Wegen des Casesensitiven habe ich wohl den ersten Durchlauf der Schleife missgedeutet;
ich hatte vergessen, dass ja auch die Titelzeile abgefragt wird.

0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)

Hallo Peter,

das mit den Verweisen stimmt so.

Mit deiner Beispieltabelle funktioniert der Code bei mir (Office 2016) ohne Probleme. Ich würde den Code nur in allgemeines Modul deiner Tabelle verschieben.

Versuche aber mal die folgende Version:

Sub Newsletter()
'Achtung: Für dieses Makro müssen im VBA-Editor unter Extras - Verweise bei Microsoft Outlook XX.0 Object Library entsprechende Haken gesetzt werden

Dim olApp As Object
Dim WsShell
Dim lngZeile As Long
Dim lngLetzte As Long
Dim strBody As String
Dim strAnlage As String
Dim oFileApp As Object
Dim oStream As Object
Dim oFile As Object
Dim strAdresse As String

'Outlook definieren
Set olApp = CreateObject("Outlook.Application")

'Mailtext aus Textdatei "Mailtext" einlesen - Name und Pfad anpassen
'UTF8-Text mit Sonderzeichen einlesen
Set oStream = CreateObject("ADODB.Stream")
oStream.Charset = "utf-8"
oStream.Open
oStream.LoadFromFile ("Z:\DB - Daten\Newsletter\Mailtext.txt")
strBody = oStream.ReadText()
oStream.Close
Set oStream = Nothing
Set oFileApp = Nothing

'Name für Newsletter generieren
'ggf. führende Nullen für Monat und Tag hinzufügen
If Month(Now) < 10 Then
  strNewsletter = Year(Now) & "-0" & Month(Now)
Else
  strNewsletter = Year(Now) & "-" & Month(Now)
End If

If Day(Now) < 10 Then
  strNewsletter = strNewsletter & "-0" & Day(Now) & ".pdf"
Else
  strNewsletter = strNewsletter & "-" & Day(Now) & ".pdf"
End If

'Pfad für Newsletter ergänzen - Pfad anpassen
strNewsletter = "Z:\DB - Daten\Newsletter\" & strNewsletter

'alle Zeilen der aktuellen Tabelle durchlaufen, dazu letzte Zeile in Spalte V ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 22).End(xlUp).Row

For lngZeile = 1 To lngLetzte

  'prüfen, ob in Spalte J ein j steht
  'alles in Kleinschrift prüfen
  If LCase(Cells(lngZeile, 22).Value) = "j" Then
    'falls ein Newsletter gewünscht,
     'prüfen, ob etwas in Spalte V (E-Mail-Adresse) steht
     If Cells(lngZeile, 10) <> "" Then
       'E-Mail generieren
         With olApp.CreateItem(0)
          strAdresse = Cells(lngZeile, 10)
          .To = strAdresse 'Empfänger"
          .Subject = "Newsletter" 'Betreff
          .Body = strBody 'Nachricht
          .ReadReceiptRequested = False 'Lesebestätigung aus
          .Attachments.Add strNewsletter    'Anhang
          .Display 'Email anzeigen
          'und hier wird die Nachricht gesendet
          .Send
        End With
     End If
  End If
Next lngZeile

Set olApp = Nothing

Set oStream = Nothing

End Sub

Gruß

M.O.

0 Punkte
Beantwortet von peters Mitglied (494 Punkte)
Bearbeitet von peters
Hallo M.O.,

der neue Code funktioniert sehr gut, danke!
(was hast Du da eigentlich genau geändert? So ganz steige ich da nicht durch)

Nun habe ich folgendes vor, vielleicht hast Du dazu eine Idee?

1. Der Code soll aus einer neuen Excel-Datei gestartet werden. In dieser Dartei soll es ein Sheet "NL-Work" geben, in dem es den Start-Button dazu geben wird (das ist kein Problem) und z.B: in Zelle "H30" der E-Mail-Text (also nicht mehr in der "Mailtext.txt").
So ist das Ganze übersichtlicher/anwenderfreundlicher.

2. Sollte die PDF-Anhang-Datei nicht vorhanden sein (der Fehler dürfte öfter auftreten, man kennt das ja ...), soll eine Msg-Box mit Fehlermeldung erscheinen und abfragen, ob abgebrochen oder ohne Anhang versendet werden soll.

3. Jeder versendete NL soll in der Art dokumentiert werden, dass eine csv-Datei mit dem aktuellen Tagesdatum erstellt wird und für jeden Empfänger eine Zeile angelegt wird in der Form "Zellinhalt A2";"Zellinhalt B2"; usw.

Gruß

Peter
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo Peter,

was habe ich geändert? Die E-Mail-Adresse wird nicht mehr direkt aus dem Blatt eingefügt, sondern erst in eine Variable eingelesen und dann eingefügt.

1. Du schreibst, dass der Code in einer neuen Excel-Datei gestartet werden soll. Bedeutet das, dass die Datei mit Adressen etc. geöffnet werden muss oder wird es in der vorhandenen Datei nur ein neues Tabellenblatt geben, aus dem der Code gestartet wird?

2. Das lässt sich machen.

3. Da muss ich mal schauen, ob und wie ich das hinbekomme.

Gruß

M.O.
0 Punkte
Beantwortet von peters Mitglied (494 Punkte)
Bearbeitet von peters
Hallo M. O.,

welchen Vorteil hat es, wenn die E-Mail-Adresse zunächst in eine Variable eingelesen wird bzw. welches Problem wird damit gelöst/umgangen?

Zu 1.
Grundsätzlich finde ich es smarter, wenn Programmcode und Daten möglichst in getrennten Dateien gehalten werden; das finde ich auf Dauer übersichtlicher und auch der "Zugriff" durch verschiedene Mitarbeiter kann besser gesteuert werden.

Deshalb soll also aus einer externen Excel-Datei heraus der Code ausgeführt werden, so dass also die DB-Kunden-Datei geöffnet (und später wieder geschlossen) werden müsste.

Allerdings gibt es in der DB-Kunden.xlsm ein Makro, das vor dem Schließen ausgeführt wird und eine Msg.Box provoziert, in der rückgefragt wird, ob gespeichert werden soll. (ist in der hochgeladenen Beispieldatei auch enthalten).

Um das zu automatisieren müsste also dieser Code entweder temporär "ausgeschaltet" werden oder die Msg-Box automatisch mit "Ja" beantwortet werden.

Zu 2.
Müsste das dann über 2 unterschiedliche Schleifen gelöst werden oder würde das in der einen Schleife mit eingebaut werden?

Zu 3.
Da habe ich 2 verschiedene Ansätze im Kopf:
3.1.
In der Schleife wird bei jedem Durchgang die besagte csv-Datei geöffnet, am Ende die Daten des jeweiligen Durchlaufs am Ende eingetragen und die Datei wieder geschlossen. Das dürfte wahrscheinlich die Laufzeit des Codes verlangsamen.

3.2.
Anstatt die Daten für die NL-Prozedur direkt aus der Kunden-DB zu lesen, könnte doch der Abfrage-Komplex "NL ja oder nein" so gesteuert werden, dass alle mit dem Ergebnis ("NL = ja" und "E-Mail-Adresse = vorhanden) in eine neue Excel-Datei mit dem aktuellen Tagesdatum als Dateiname geschrieben werden.
Auch für den Versand irrelevante Felder ließen sich für etwaige Dokumentation dort frei hineinschreiben (z. B. der aktuelle Ansprechpartner).
Der eigentliche Versand könnte dann die bereits selektierten Daten aus dieser tagesaktuellen Datei nutzen.

Oder denke ich da zu kompliziert?

Gruß

Peter
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)

Hallo Peter,

welches Problem wird damit gelöst/umgangen?

Deine Fehlermeldung taucht nicht mehr auf. wink

Bezüglich der Umsetzung zu Punkt 3 tendiere ich zu deiner Lösung mit dem Tagesdatum. Das wird übersichtlicher, wenn du etwas suchst. Aber die Daten zuerst in die Datei zu schreiben und dann noch einmal auszulesen, um die E-Mails zu generieren ist doch etwas umständlich. Das geht auch einfacher. 

Ich schreibe den Code einfach mal so, wie ich es denke und dann kannst du den Code ja mal ausprobieren.

Gruß

M.O.

0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)

Hallo Peter,

kopieren den Code in ein allgemeines Modul deiner Start-Tabelle. Ich gehe davon aus, dass die Datenbank-Datei und der Newsletter im selben Verzeichnis liegen. Auch die Log-Datei wird in diesem Verzeichnis gespeichert. Beachte bitte, dass die Log-Datei ggf. ohne Nachfrage überschrieben wird, falls an einem Tag das Makro mehrmals ausgeführt wird.

Sub newsletter()
'Achtung: Für dieses Makro müssen im VBA-Editor unter Extras - Verweise bei Microsoft Outlook XX.0 Object Library entsprechende Haken gesetzt werden

Dim vDB As Variant
Dim lngLZ As Long
Dim lngLS As Long
Dim i As Integer
Dim wbKunden As Workbook
Dim olApp As Object
Dim strBody As String
Dim strAnlage As String
Dim Antwort
Dim bNewsletter As Boolean
Dim wbNewsletter As Workbook
Dim strName As String
Dim strPfad As String
Dim strNeu As String
Dim lngZeile As Long

'Pfad für Newsletter und Protokolldatei festlegen - anpassen
strPfad = "C:\DB - Daten\Newsletter\"

'Name für Newsletter generieren
'ggf. führende Nullen für Monat und Tag hinzufügen
If Month(Now) < 10 Then
  strNewsletter = Year(Now) & "-0" & Month(Now)
Else
  strNewsletter = Year(Now) & "-" & Month(Now)
End If

If Day(Now) < 10 Then
  strNewsletter = strNewsletter & "-0" & Day(Now)
Else
  strNewsletter = strNewsletter & "-" & Day(Now)
End If

'Name für Excel-Datei in Variable schreiben
strName = strNewsletter

'Pfad für Newsletter ergänzen und Endung für PDF ergänzen - Pfad anpassen
strNewsletter = strPfad & strNewsletter & ".pdf"

bNewsletter = True      'ein Newsletter wird mit verschickt

'Prüfen, ob Newsletter vorhanden ist
If Dir(strNewsletter) = "" Then
  'falls nicht vorhanden, nachfragen, ob trotztdem E-Mail verschickt soll
   Antwort = MsgBox("Achtung! Der Newsletter " & strNewsletter & " ist nicht vorhanden? Sollen die E_Mails trotzdem verschickt werden?", 20, "Kein Newsletter vorhanden")
   If Antwort = vbNo Then
      Exit Sub  'Makro beenden, falls Nein gedrückt wurde
     Else
      bNewsletter = False   'kein Newsletter im Anhang
   End If
End If

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Mögliche Nachfragen und Hinweise ausschalten
Application.DisplayAlerts = False

'Datei mit Kundendatenbank öffnen
'Pfad und Name anpassen;
Set wbQuelle = Workbooks.Open(strPfad & "DB - Kunden.xlsm")
'letzte Zeile und Spalte ermitteln
With wbQuelle.Worksheets("Adressen")
  lngLZ = .Cells(Rows.Count, 1).End(xlUp).Row       'letzte Zeile in Spalte A ermitteln
  lngLS = .UsedRange.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte ermitteln
  'Daten in Array einlesen
  vDB = .Range(.Cells(1, 1), .Cells(lngLZ, lngLS))
End With

'Datei wieder schließen ohne Änderungen zu speichern
wbQuelle.Close (False)

'Variable zurücksetzen
Set wbQuelle = Nothing

'Mail-Text in Variable einlesen
strBody = ThisWorkbook.ActiveSheet.Range("H30")

'Outlook definieren
Set olApp = CreateObject("Outlook.Application")

'Datei für Nachverfolgung Versand Newsletter erstellen
Set wbNewsletter = Workbooks.Add
strNeu = wbNewsletter.Name
'Überschriften einfügen
With Workbooks(strNeu).Worksheets(1)
  .Range("A1") = "Name"
  .Range("B1") = "E-Mail"
  .Range("C1") = "Newsletter"
  With .Range("A1:C1")
   .Font.Bold = True                   'Fett
   .HorizontalAlignment = xlCenter     'zentriert
  End With
End With

'1. Einfügezeile festlegen
lngZeile = 2

'Array ab Zeile 2 durchlaufen (Zeile 1 = Überschriften)
For i = 2 To UBound(vDB, 1)
  'prüfen ob Newsletter gewünscht ist, Spalte V
  If LCase(vDB(i, 22)) = "j" Then
     'prüfen, ob etwas in Spalte V (E-Mail-Adresse) steht
     If vDB(i, 10) <> "" Then
       'E-Mail generieren
         With olApp.CreateItem(0)
          strAdresse = vDB(i, 10)
          .To = strAdresse 'Empfänger"
          .Subject = "Newsletter" 'Betreff
          .Body = strBody 'Nachricht
          .ReadReceiptRequested = False 'Lesebestätigung aus
          If bNewsletter = True Then .Attachments.Add strNewsletter    'Anhang
          .Display 'Email anzeigen
          'und hier wird die Nachricht gesendet
          '.Send
        End With
        'Daten in Excel-Tabelle schreiben
         With Workbooks(strNeu).Worksheets(1)
           .Cells(lngZeile, 1) = vDB(i, 1)  'Name in Spalte A Schreiben
           .Cells(lngZeile, 2) = vDB(i, 10) 'E-Mail-Adresse in Spalte B schreiben
           If bNewsletter = False Then
               .Cells(lngZeile, 3) = "ohne Newsletter"   'falls Nachricht ohne Newsletter versandt wurde
           Else
               .Cells(lngZeile, 3) = strName & ".pdf"     'Nachricht wurde mit Newsletter versandt
           End If
         End With
         'Einfügezeile erhöhen
         lngZeile = lngZeile + 1
        End If
  End If
Next i

Set olApp = Nothing       'zurücksetzen

With Workbooks(strNeu)
  With .Worksheets(1)
    .Columns("A:C").EntireColumn.AutoFit     'Spaltenbreite in der neuen Excel-Datei anpassen
  End With
  'Datei speichern
  .SaveAs Filename:=strPfad & strName
  .Close
End With

'Nachfragen wieder anzeigen
Application.DisplayAlerts = True

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Gruß

M.O.

...