Persönliche Anrede bei E-Mails

Bild

Betrifft: Persönliche Anrede bei E-Mails
von: Benni
Geschrieben am: 27.10.2015 14:20:38

Hallo zusammen,
ich komme als VBA-Anfänger leider echt nicht mehr weiter. Ich hatte hier schon einmal gepostet und habe von Martin dann auch Hilfe bekommen :)
Mein code (den ich hauptsächlich zusammengegooglet habe und angepasst habe) funktioniert gut, allerdings schaffe ich es nicht, eine persönliche Anrede mit einzubauen.
Ich schaffe es nur die Anrede auf eine Zelle zu beziehen, sprich wenn bspw. in Zelle e12= Frau, dann ist die Anrede "Sehr geehrte Frau X".
Aber ich bekomme es nicht hin, dass die Anrede für alle Namen in Spalte E variert.
Ich hab euch den Code, den ich verwende, angehängt.
Kann mir da jemand helfen? Ich komme da leider echt nicht weiter :(
Viele Grüße
Benni

Sub lotus()
    Dim sText As Variant, sEmpfang As Variant, sBetrifft As String
    Dim session As Object, db As Object, doc As Object, rtobject, ws As Object
    Dim x As Integer, y As Integer, Msg As Integer
    Dim sKopie As String, AttachMe As Object, DerAnhang As Object
    Dim user As String, server As String, mailfile As String, sBlindKopie As String
    Dim vAn As Variant, vCopy As Variant, vBlind As Variant, sAnhang As String
    Dim sAnrede As Variant
    Dim sVorname As Variant
    Dim sNachname As Variant
    Dim tempAnrede As Variant
 
For i = 12 To Cells(Rows.Count, 9).End(xlUp).Row
  If Cells(i, 10) <> "ja" Then ' keine E-Mail, wenn "ja" in Spalte "geantwortet"
    vAn = vAn & "; " & Cells(i, 9)
  End If
Next i
vAn = Mid(vAn, 3)
 sAnrede = Range("e12") 'Anrede in Spalte e
     If sAnrede = "Herr" Then 'wenn in Spalte "e" Anrede "Herr" dann
     tempAnrede = "Sehr geehrter Herr"
     ElseIf sAnrede = "Frau" Then 'wenn in Spalte "e" Anrede "Frau" dann
     tempAnrede = "Sehr geehrte Frau"
     ElseIf sAnrede = "Dear" Then 'wenn in Spalte "e" Anrede "Dear" dann
     tempAnrede = "Dear"
     End If
     
    sVorname = Range("f12") 'Vorname in Spalte f
    sNachname = Range("g12") 'Nachname in Spalte g
    
If Sheets("Tabelle1").Range("h12").Value = "Deutsch" Then 'wenn in Spalte "h" "Deutsch" dann
    sText = tempAnrede & " " & sNachname & "," & vbCrLf & vbCrLf & Range("B4") & vbCrLf ' Text  _
aus Zelle B4
    sText = Replace(sText, vbCrLf, Chr(10)) ' Zeilenumbrüche ändern
    Else
    sText = tempAnrede & " " & sVorname & "," & vbCrLf & vbCrLf & Range("D4") & vbCrLf ' wenn  _
nicht, dann Text aus Zelle B4
    sText = Replace(sText, vbCrLf, Chr(10)) ' Zeilenumbrüche ändern
    End If
    sBetrifft = Range("B3") ' Überschrift in Zelle b3
   
    'Wenn du keine Kopie od Blindkopie versenden willst, dann grad weglassen
   
    sKopie = Range("D3") ' Einträge durch " ; " getrennt Kopietest@gmx.de
    'sBlindKopie = "Email1 ; Email2 " ' Einträge durch " ; " getrennt
 
    sAnhang = Range("B6") ' Link aus Zelle b6
    sAnhang2 = Range("B7") ' Link aus Zelle b7
    sAnhang3 = Range("B8") ' Link aus Zelle b8
    If Len(sKopie) > 0 Then vCopy = Split(sKopie, " ; ") 'cc Array
    If Len(sBlindKopie) > 0 Then vBlind = Split(sBlindKopie, " ; ")  'bcc Array
    Set session = CreateObject("notes.notessession") ' Notes muss gestartet sein
    user = session.UserName
    server = session.GetEnvironmentString("MailServer", True)
    mailfile = session.GetEnvironmentString("MailFile", True)
    Set db = session.GetDatabase(server, mailfile)
    Set doc = db.createdocument()
    doc.Form = "Memo"
    doc.SendTo = vAn 'an array
    If Len(sKopie) > 0 Then doc.CopyTo = vCopy 'cc Array
    If Len(sBlindKopie) > 0 Then doc.blindcopyto = vBlind 'bcc Array
    doc.Subject = sBetrifft ' die Betreffzeile
   
    doc.SAVEMESSAGEONSEND = True
    doc.PostedDate = Now
    'Die Zeilen mit dem Anhang nach hier oben verschieben, ist wichtig die Reihenfolge
    ' *******************************************
    If sAnhang <> "" Then
        Set AttachMe = doc.CREATERICHTEXTITEM("Attachment")
        Set DerAnhang = AttachMe.EMBEDOBJECT(1454, "", sAnhang)
        Set DerAnhang2 = AttachMe.EMBEDOBJECT(1454, "", sAnhang2)
        Set DerAnhang3 = AttachMe.EMBEDOBJECT(1454, "", sAnhang3) ',"Attachment" wird nicht benö _
tigt
         End If
    '*******************************
    Set ws = CreateObject("Notes.NotesUIWorkspace") ' **durch das öffnen des Dokumentes durch  _
NotesUIWorkspace**
    Call ws.EDITDOCUMENT(True, doc)             ' **erreicht man das die eingestellte Signatur  _
aus den    **
    Set doc = ws.CURRENTDOCUMENT                      ' **Lotus Notes Optionen eingefügt wird    _
                **
    Call doc.GOTOFIELD("Body")
    Call doc.insertText(sText)
    Call doc.Send(True)
    Call doc.Close               'Schliesst das gesendete Formular
    Call doc.Save(True, True)
Aufraeumen:
    On Error Resume Next
    Set AttachMe = Nothing
    Set DerAnhang = Nothing
    Set ws = Nothing
    Set doc = Nothing
    Set db = Nothing
    Set session = Nothing
    Exit Sub
Fehler:
    Resume Aufraeumen
End Sub

Bild

Betrifft: AW: Persönliche Anrede bei E-Mails
von: Esmo
Geschrieben am: 27.10.2015 16:52:54
Moin!
Dein Code schickt doch nur eine E-Mail an alle vAn? Oder macht er eine Nachricht an alle Elemente in vAn?
Die Empfänger stellst Du als Feld zusammen, aber die Anrede wird nur ein Mal generiert aus der Zeile 12? Die müsstest Du dann auch über die Schleife aus der entsprechen Zeile auslesen. Also statt

sAnrede = Range("e12") 'Anrede in Spalte e
     If sAnrede = "Herr" Then 'wenn in Spalte "e" Anrede "Herr" dann
     tempAnrede = "Sehr geehrter Herr"
     ElseIf sAnrede = "Frau" Then 'wenn in Spalte "e" Anrede "Frau" dann
     tempAnrede = "Sehr geehrte Frau"
     ElseIf sAnrede = "Dear" Then 'wenn in Spalte "e" Anrede "Dear" dann
     tempAnrede = "Dear"
     End If

dann eher
  sAnrede = Range("e" & i ) 'Anrede in Spalte e
  Select Case (sAnrede)
    Case "Herr":
      tempAnrede = "Sehr geehrter Herr"
    Case "Frau":
      tempAnrede = "Sehr geehrte Frau"
    Case "Dear":
      tempAnrede = "Dear"
  End Select

und analog für die Namen, Vornamen und den Text,den Du zusammenbaust.

sVorname = Range("f" & i ) 'Vorname in Spalte f
    sNachname = Range("g" & i) 'Nachname in Spalte g
Dann musst Du aber die Schleife, die mit Next i endet, weiter unten beenden.
Außerdem solltest Du nicht vergessen, daß die Struktur Deiner Daten für das Verständnis Deines Codes nicht ganz unwichtig ist. Wenn man sich das nicht erarbeiten muss, hilft das auch.
Und noch ein Tipp: (korrektes) Einrücken hilft bei der Übersichtlichkeit.

Bild

Betrifft: AW: Persönliche Anrede bei E-Mails
von: Benni
Geschrieben am: 28.10.2015 08:33:32
Hallo Esmo,
vielen Dank für deine Hilfe und deine Intputs!
Der Code schickt die Nachricht an jeden Empfänger. Ich weiß nicht, wie das geht, dass der Code für jeden Empfänger eine eigene Nachricht erstellt :( (Habe den Code aber jetzt geändert, dass die E-Mail als Blindkopie versendet)
Wie gesagt, ich bin ein ziemlicher Anfänger und versuche mich einzuarbeiten.
Ich hatte mal eine ähnliche Schleife und da das gleiche Problem wie jetzt.
Er nimmt immer nur die letzte Anrede in der Spalte e und baut dann immer nur die letzte Anrede ein. Sprich wenn unten "Dear" als Anrede steht, bekommen alle Emfänger die Anrede "Dear".
An was liegt das denn?
Hab den Code jetzt dementsprechend angepasst. Hoffe, du kannst mir helfen, bin schon ziemlich am verzweifeln.


Sub lotus()
    Dim sText As Variant, sEmpfang As Variant, sBetrifft As String
    Dim session As Object, db As Object, doc As Object, rtobject, ws As Object
    Dim x As Integer, y As Integer, Msg As Integer
    Dim sKopie As String, AttachMe As Object, DerAnhang As Object
    Dim user As String, server As String, mailfile As String, sBlindKopie As String
    Dim vAn As Variant, vCopy As Variant, vBlind As Variant, sAnhang As String
    Dim sAnrede As Variant
    Dim sVorname As Variant
    Dim sNachname As Variant
    Dim tempAnrede As Variant
     
    For i = 12 To cells(Rows.Count, 9).End(xlUp).Row
        If cells(i, 10) <> "ja" Then                            'keine E-Mail, wenn "ja" in  _
Spalte "geantwortet"
            vAn = vAn & "; " & cells(i, 9)
        End If
    sAnrede = Range("e" & i)                                    'Anrede aus Spalte e
    Select Case (sAnrede)
        Case "Herr":                                            'Im Fall, dass Anrede "Herr" in  _
Spalte e, dann schreibe "Sehr geehrter Herr"
            tempAnrede = "Sehr geehrter Herr"
        Case "Frau":
            tempAnrede = "Sehr geehrte Frau"                    'Im Fall, dass Anrede "Frau" in  _
Spalte e, dann schreibe "Sehr geehrte Frau"
        Case "Dear":
        tempAnrede = "Dear"                                     'Im Fall, dass Anrede "Dear" in  _
Spalte e, dann schreibe "Dear"
    End Select
    
    sVorname = Range("f" & i)                                   'Vorname aus Spalte f
      
    sNachname = Range("g" & i)                                  'Nachname aus Spalte g
    
    If Sheets("Tabelle1").Range("h" & i).Value = "Deutsch" Then                                  _
'wenn in Spalte "h" "Deutsch" als Sprache steht, dann
        sText = tempAnrede & " " & sNachname & "," & vbCrLf & vbCrLf & Range("B4") & vbCrLf      _
' dann nehme die Anrede + Nachnamen + den Text aus Zelle "B4"
        sText = Replace(sText, vbCrLf, Chr(10)) ' Zeilenumbrüche ändern
    Else
        sText = tempAnrede & " " & sVorname & "," & vbCrLf & vbCrLf & Range("D4") & vbCrLf       _
' sonst nehme Anrede + Vorname + Text aus Zelle "D4"
        sText = Replace(sText, vbCrLf, Chr(10)) ' Zeilenumbrüche ändern
    End If
   Next i
   
   vAn = Mid(vAn, 3)
    sBetrifft = Range("B3") ' Überschrift in Zelle b3
   
      
    sKopie = Range("D3")                                        ' Kopie der E-MAil an e-Mail  _
Adresse aus Zelle "D3"
    sBlindKopie = Mid(vAn, 3)                                   'schickt an alle Empfänger eine  _
Blindkopie
    sAnhang = Range("B6")                                       ' Link aus Zelle b6
    sAnhang2 = Range("B7")                                      ' Link aus Zelle b7
    sAnhang3 = Range("B8")                                      ' Link aus Zelle b8
    If Len(sKopie) > 0 Then vCopy = Split(sKopie, " ; ")        ' cc Array
    If Len(sBlindKopie) > 0 Then vBlind = Split(sBlindKopie, " ; ")  'bcc Array
    Set session = CreateObject("notes.notessession") ' Notes muss gestartet sein
    user = session.UserName
    server = session.GetEnvironmentString("MailServer", True)
    mailfile = session.GetEnvironmentString("MailFile", True)
    Set db = session.GetDatabase(server, mailfile)
    Set doc = db.createdocument()
    doc.Form = "Memo"
    
    If Len(sKopie) > 0 Then doc.CopyTo = vCopy 'cc Array
    If Len(sBlindKopie) > 0 Then doc.blindcopyto = vAn 'bcc Array
    doc.Subject = sBetrifft ' die Betreffzeile
   
    doc.SAVEMESSAGEONSEND = True
    doc.PostedDate = Now
    'Die Zeilen mit dem Anhang nach hier oben verschieben, ist wichtig die Reihenfolge
    ' *******************************************
    If sAnhang <> "" Then
        Set AttachMe = doc.CREATERICHTEXTITEM("Attachment")
        Set DerAnhang = AttachMe.EMBEDOBJECT(1454, "", sAnhang)
        Set DerAnhang2 = AttachMe.EMBEDOBJECT(1454, "", sAnhang2)
        Set DerAnhang3 = AttachMe.EMBEDOBJECT(1454, "", sAnhang3) ',"Attachment" wird nicht benö _
tigt
         End If
    '*******************************
    Set ws = CreateObject("Notes.NotesUIWorkspace") ' **durch das öffnen des Dokumentes durch  _
NotesUIWorkspace**
    Call ws.EDITDOCUMENT(True, doc)             ' **erreicht man das die eingestellte Signatur  _
aus den    **
    Set doc = ws.CURRENTDOCUMENT                      ' **Lotus Notes Optionen eingefügt wird    _
                **
    Call doc.GOTOFIELD("Body")
    Call doc.insertText(sText)
    Call doc.Send(True)
    Call doc.Close               'Schliesst das gesendete Formular
    Call doc.Save(True, True)
Aufraeumen:
    On Error Resume Next
    Set AttachMe = Nothing
    Set DerAnhang = Nothing
    Set ws = Nothing
    Set doc = Nothing
    Set db = Nothing
    Set session = Nothing
    Exit Sub
Fehler:
    Resume Aufraeumen
End Sub


Bild

Betrifft: AW: Persönliche Anrede bei E-Mails
von: Esmo
Geschrieben am: 29.10.2015 01:04:46
Hallo Benni,
das Prinzip, was du willst ist (ohne Details):
für jede Zeile von 1 bis 150
Anrede zusammenbauen
E-Mail-Text aus Anrede+Text bauen
verschicken
Was Du anfangs machtest.
Die Adresse sind zusammengesammelt in der ersten Schleife (vAn)
Danach hast Du aus Dann den Text mit Anrede zusammen gebaut
Dnach den immer gleichen E-Mail-Text an 150 Leute geschickt
Was Du jetzt machst:
von Zeile 1 bis 150
Adressen zusammensammeln
jeweils Anrede zusammenbauen
danach
Email-Text aus Text+Anrede (das ist die letzte aktive, aus Zeile 150) bauen
diesen Text an die 150 Absender verschicken
Langer Rede kurzer Sinn - Dir ist wohl noch nicht klar, daß die Schleife viel weiter gehen muß.


Sub lotus()
  Dim sText As Variant, sEmpfang As Variant, sBetrifft As String
  Dim session As Object, db As Object, doc As Object, rtobject, ws As Object
  Dim x As Integer, y As Integer, Msg As Integer
  Dim sKopie As String, AttachMe As Object, DerAnhang As Object
  Dim user As String, server As String, mailfile As String, sBlindKopie As String
  Dim vAn As Variant, vCopy As Variant, vBlind As Variant, sAnhang As String
  Dim sAnrede As Variant
  Dim sVorname As Variant
  Dim sNachname As Variant
  Dim tempAnrede As Variant
     
  ' Verbindung zum Mailserver aufbauen
  Set session = CreateObject("notes.notessession") ' Notes muss gestartet sein
  user = session.UserName
  server = session.GetEnvironmentString("MailServer", True)
  mailfile = session.GetEnvironmentString("MailFile", True)
  Set db = session.GetDatabase(server, mailfile)
  ' Emails zusammenbauen und rausschicken
  For i = 12 To Cells(Rows.Count, 9).End(xlUp).Row
    If Cells(i, 10) <> "ja" Then  'keine E-Mail, wenn "ja" in Spalte "geantwortet"
      vAn = Cells(i, 9)
      sAnrede = Range("e" & i) 'Anrede aus Spalte e
      Select Case (sAnrede)
        Case "Herr":           'Im Fall, dass Anrede "Herr" in _
                    Spalte e, dann schreibe "Sehr geehrter Herr"
          tempAnrede = "Sehr geehrter Herr"
        Case "Frau":
          tempAnrede = "Sehr geehrte Frau" 'Im Fall, dass Anrede "Frau" in _
              Spalte e, dann schreibe "Sehr geehrte Frau"
        Case "Dear":
          tempAnrede = "Dear" 'Im Fall, dass Anrede "Dear" in _
        Spalte e, dann schreibe "Dear"
      End Select
      sVorname = Range("f" & i) 'Vorname aus Spalte f
      sNachname = Range("g" & i) 'Nachname aus Spalte g
      If Sheets("Tabelle1").Range("h" & i).Value = "Deutsch" Then
        'wenn in Spalte "h" "Deutsch" als Sprache steht, dann
        sText = tempAnrede & " " & sNachname & "," & Chr(10) & _
                  Chr(10) & Range("B4") & Chr(10)
        'dann nehme die Anrede + Nachnamen + den Text aus Zelle "B4"
      Else
        sText = tempAnrede & " " & sVorname & "," & Chr(10) & Chr(10) _
                & Range("D4") & Chr(10) _
        ' sonst nehme Anrede + Vorname + Text aus Zelle "D4"
      End If
      sBetrifft = Range("B3") ' Überschrift in Zelle b3
      sKopie = Range("D3") ' Kopie der E-MAil an e-Mail Adresse aus Zelle "D3"
      sBlindKopie = Mid(vAn, 3) 'schickt an alle Empfänger eine Blindkopie
      sAnhang = Range("B6")                                       ' Link aus Zelle b6
      sAnhang2 = Range("B7")                                      ' Link aus Zelle b7
      sAnhang3 = Range("B8")                                      ' Link aus Zelle b8
      If Len(sKopie) > 0 Then vCopy = Split(sKopie, " ; ")        ' cc Array
      If Len(sBlindKopie) > 0 Then vBlind = Split(sBlindKopie, " ; ")  'bcc Array
      Set doc = db.createdocument()
      doc.Form = "Memo"
      If Len(sKopie) > 0 Then doc.CopyTo = vCopy 'cc Array
      If Len(sBlindKopie) > 0 Then doc.blindcopyto = vAn 'bcc Array
      doc.Subject = sBetrifft ' die Betreffzeile
      doc.SAVEMESSAGEONSEND = True
      doc.PostedDate = Now
    'Die Zeilen mit dem Anhang nach hier oben verschieben, ist wichtig die Reihenfolge
    ' *******************************************
      If sAnhang <> "" Then
        Set AttachMe = doc.CREATERICHTEXTITEM("Attachment")
        Set DerAnhang = AttachMe.EMBEDOBJECT(1454, "", sAnhang)
        Set DerAnhang2 = AttachMe.EMBEDOBJECT(1454, "", sAnhang2)
        Set DerAnhang3 = AttachMe.EMBEDOBJECT(1454, "", sAnhang3)
        ',"Attachment" wird nicht benötigt
      End If
    '*******************************
      Set ws = CreateObject("Notes.NotesUIWorkspace")
      ' **durch das öffnen des Dokumentes durch NotesUIWorkspace**
      ' **erreicht man das die eingestellte Signatur aus den **
      ' **Lotus Notes Optionen eingefügt wird
      Call ws.EDITDOCUMENT(True, doc)
      Set doc = ws.CURRENTDOCUMENT
      Call doc.GOTOFIELD("Body")
      Call doc.insertText(sText)
      Call doc.Send(True)
      Call doc.Close               'Schliesst das gesendete Formular
      Call doc.Save(True, True)
      Set AttachMe = Nothing
      Set DerAnhang = Nothing
      Set ws = Nothing
      Set doc = Nothing
    
    End If
  Next i
   ' Verbindung zum Mailserver löschen
Aufraeumen:
    On Error Resume Next
    Set db = Nothing
    Set session = Nothing
    Exit Sub
Fehler:
    Resume Aufraeumen
End Sub

Ich habe hier auch gleich die Verbindung zum Mailserver noch aus der Schleife genommen, sonst wird die 150 mal aufgebaut, das ist wohl nicht nötig.
Hoffe, es geht trotzdem noch und das Prinzip ist klar?

Bild

Betrifft: AW: Persönliche Anrede bei E-Mails
von: Benni
Geschrieben am: 29.10.2015 08:18:42
Hallo Esmo,
nein, das war mir echt nicht bewusst. Aber jetzt durch deine Erklärung denke ich, dass ich es verstanden habe!
Der Code funktioniert auch perfekt! Vielen, vielen lieben Dank!
Auch wenn ich zwischendrin verzweifelt bin, ich muss sagen, dass ich echt Gefallen gefunden habe :)
Grüße

Bild

Betrifft: AW: Persönliche Anrede bei E-Mails
von: Benni
Geschrieben am: 29.10.2015 15:17:20
Hallo Esmo,
zwei Fragen habe ich jetzt allerdings doch noch, manchmal kommt die Meldung "Die Objektvariable oder die With-Blockvariable wurde nicht festgelegt"
1. Wieso kommt die Meldung nur manchmal?
2. Was bedeutet sie? :)
Viele Grüße

Bild

Betrifft: AW: Persönliche Anrede bei E-Mails
von: Esmo
Geschrieben am: 30.10.2015 17:32:46
Moin Benni,
1. kann ich Dir nicht so nicht beantworten, den Code kann ich auch nicht testen (mangels notes)
2. Wenn Du ein Objekt definierst (DIM ar as Variant set ar = range("A4")) und da was schief gelaufen ist bei der Zuweisung, dann kann er ja für diese Variable kein Ziel finden. Und das With benutzt man, um Schreibarbeit zu sparen. Statt

Range("A1").Currentregion.Rows(5).interior.Color = 5
Range("A1").Currentregion.Rows(5).interior.Font.bold = true
Range("A1").Currentregion.Rows(5).interior.borders width:=4

kannst Du dann schreiben
With Range("A1").Currentregion.Rows(5).interior
  .Color = 5
  .Font.bold = true
  .borders width:=4
End with

was natürlich kürzer und übersichtlicher ist. Kann auch geschachtelt werden. Schau Dir mal die Hilfe dazu an. Man muß nur beachten, daß sich - falls sich durch den Code innen die Referenz ändern würde (also ich zum Beispiel im With/End With noch eine Zeile dazufüge, so daß eigentlich Range("A1").Currentregion dann 1 Zeile mehr hat, bezieht sich die Referenz trotzdem nur auf die Referenz zum ursprünglichen Zeitpunkt).
Dann wünsche ich Dir weiterhin noch Spaß mit Excel/VBA und nicht allzu viel verzweifeln. Für das Fehlersuchen ist es ganz gut, Dir einfach noch mal den Ablauf, was Du tun willst, abstrakt aufzuschreiben und dann zu schauen, ob Dein Code dazu paßt.
Schönes WE
Ralph

 Bild

Beiträge aus den Excel-Beispielen zum Thema "SQL Abfrage in VBA"