Spalte als Empfänger für generierte Mail nutzen
28.03.2017 15:44:11
Julian
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:
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
Die Empfänger stehen bei mir 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.
Sprich an Ende sollen alle in Spalte H aufgelisteten E-Mail Adressen in der Empfängerzeile in Outlook auftauchen.
Vielen Dank vorab!
Gruß
Julian