Office: Email Empfänger aus einer Spalte hinzufügen?

Energizer123 · 26. März 2017

Hallo zusammen,

Ich habe ein Problem mit einem Makro. In diesem wird z.Z. eine Mail über eine Schaltfläche im Excel generiert und die derzeitige Tabelle als Anhang hinzugefügt. Hier der Code:

Code:

Private Sub CommandButton1_Click()
Dim olApp As Object
Dim wdApp As Object
Dim wdDoc As Object
Dim wdRange As Object
Dim olOldbody As String
Dim olNewBody As String
Dim lngZelle As Long
Dim AWS As String

If ThisWorkbook.Saved = False Then

'Die letzten Änderungen wurden noch nicht gespeichert
Qe = MsgBox("Diese Mappe wurde noch nicht gespeichert, und kann nicht versandt werden!" _
& Chr$(13) & "Soll die Datei gespeichert werden?", vbInformation + vbYesNo, "Sendefehler")
If Qe = vbNo Then

'Abbruch durch Benutzer
MsgBox "Sendevorgang abgebrochen"
Exit Sub

Else
'Prüfen ob die Datei schon mal gespeichert wurde
If Right(ThisWorkbook.Name, 3) "xls" Then
'Nein > Speicherdialog aufrufen
Application.Dialogs(xlDialogSaveAs).Show
Else
'Speichern
ThisWorkbook.Save
End If

End If

End If

Rem Emailtext erstellen
olNewBody = "......." & "" ' Grußzeile
olNewBody = olNewBody & "..." & ""
olNewBody = olNewBody & "...." & ""
olNewBody = olNewBody & "..."
olNewBody = olNewBody & "

...."
olNewBody = olNewBody & "

..."
olNewBody = olNewBody & "

...

"
olNewBody = olNewBody & "Vielen Dank für Ihre Mitwirkung." & ""
olNewBody = olNewBody & "Freundliche Grüße"

'Die aktuelle Mappe als Anhang senden
AWS = ThisWorkbook.FullName
Rem Outlook-Objekt erstellen
Set olApp = CreateObject("Outlook.Application")
Rem Email erstellen
With olApp.CreateItem(0)
.GetInspector.Display
olOldbody = .htmlBody
.To = "..."
.Subject = "..." & Date & " " & Time
.htmlBody = olNewBody
.Attachments.Add AWS

Rem Word-Editor-Objekt erstellen (zum Formatieren erforderlich)
Set wdApp = .GetInspector
Set wdDoc = wdApp.WordEditor
Set wdRange = wdDoc.Range
wdRange.WholeStory

Rem Emailtext formatieren
With wdRange

Rem Schriftart und Schriftgröße festlegen
.Font.Name = "Calibri"
.Font.Size = 11

End With

Rem Untersreichen und Fett
Set wdRange = wdDoc.Range(41, 69 + lngZelle)
With wdRange
.Font.Underline = False
.Font.Bold = False
End With

Rem Emailtext um Signatur ergänzen
.htmlBody = .htmlBody & olOldbody

End With

Rem Objekte freigeben
Set wdRange = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
Set olApp = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mein Problem:
Die Empfänger stehen bei mir in einer gewissen Tabelle in Spalte H beginnend mit Zeile 11 und endend bei Zeile 347. wie bekomme ich die in die Mail verpackt? Am besten so, dass falls welche doppelt vorkommen diese gleich als "eine" Mailadresse zusammengefügt werden.

Vielen Dank vorab!

Gruß
Julian

:)

Energizer123 · 28. März 2017

Gebe ich einfach ein:

Code:

.to = Range ("H11:H347").Value
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

sagt er mir Laufzeitfehler 440: Automatisierungsfehler...

Der Code um die Spalte H in die Empfängerleiste zu packen ist wahrscheinlich relativ simpel, nur hapert es bei mir einfach in Sachen VBA-Skills *frown.gif*

Gruß

R J · 28. März 2017

Hi Energizer,

Am besten so, dass falls welche doppelt vorkommen diese gleich als "eine" Mailadresse zusammengefügt werden.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

...also.... als eine gelten, indem doppelte vermieden werden....*wink.gif*

Generell spricht das schon für eine schlechte Datengrundlage wenn doppelte vorhanden sind. Ich würde mal checken, ob Du die Duplikate nicht dauerhaft entfernen kannst. Geht aber auch nur, wenn die Datenstruktur optimal aufgebaut wurde.
Als Empfängerliste wird ein Semikolonseparierter Wert erwartet. Wenn tatsächlich Dubletten vorhanden sind, die nicht entfernt werden können, dann empfiehlt es sich die vorher in ein Dictionary einzulesen.
Ansonsten genügt das:
Code:

Function Empfänger(ausSpalte As String) As String
Dim z&, liste$
For z = 11 To 347 'oder so: Cells.SpecialCells(xlCellTypeLastCell).Row
liste = liste & Cells(z, ausSpalte) & "; "
Next z
Empfänger = Left(liste, Len(liste) - 2)
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Aufruf aus Deiner Prozedur mit:
Code:

Dim recip$
recip = Empfänger("H")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

und dann kannst Du sagen
Code:

.to =recip
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

oder gleich Code:

.to = Empfänger("H")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Energizer123 · 28. März 2017

Hallo nochmals,

falls iwann nochmals jemand eine Lösung braucht, hier eine, welche ich anderweitig gefunden hab:

Code:

Sub ÜberEmpfängerIterieren()
Dim rngZelle As Range
Dim rngBereich As Range
Dim wksBlatt As Worksheet
Dim strEmpfänger As String
Dim y As Long

y = 11

Set wksBlatt = ThisWorkbook.Worksheets("Tabelle3")

With wksBlatt
Set rngBereich = .Range("H11:H347")
For Each rngZelle In rngBereich
If Application.WorksheetFunction.CountIf(.Range("H11:H" & y), rngZelle.Value) = 1 _
Then
strEmpfänger = strEmpfänger & ";" & rngZelle.Value
End If
y = y + 1
Next rngZelle
strEmpfänger = Right(strEmpfänger, Len(strEmpfänger) - 1)
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Diesen Code kann man einfach in den o.g. und bereits bestehenden einfügen und es klappt alles so wie gewollt.

Gruß
Julian

Energizer123 · 28. März 2017

Hey Ralf,

sorry hatte deinen Post erst gelesen als ich bereits abgeschickt hatte^^. Wie bereits erwähnt bin ich bereits fündig geworden. Werde mir deine Variante morgen mal anschauen. Auch dir schonmal ein Dankeschön für die Mühe *Smilie .

Gruß

Office: Email Empfänger aus einer Spalte hinzufügen?

Email Empfänger aus einer Spalte hinzufügen?

Email Empfänger aus einer Spalte hinzufügen?

Email Empfänger aus einer Spalte hinzufügen?

Email Empfänger aus einer Spalte hinzufügen? - Similar Threads - Email Empfänger Spalte

VBA eine Mail Empfänger aus Zellen ziehen

DomainFactory Email - kein Empfang in Outlook

Outlook 2021 - Emails werden nicht korrekt angezeigt/empfangen

Dritter kann email konversation mitlesen, ohne Empfänger zu sein.

Email an mehrere Adressaten

variabler Email-Empfänger

Empfänger in der E-Mail größer darstellen