Hallo zusammen,
habe hier eine Frage:
Ich habe vor unterschiedliche Abteilungen über einen Verteiler jeweils per Button zu versenden.
Da sich die Verteiler unterschiedlich zusammensetzen und es keine entspr. Verteiler in Outlook gibt, die gepflegt werden,
habe ich mir ein Blatt mit mehreren Abteilungen erstellt.
In diesem Fall (s.unten) soll die Mail an alle Abteilungen gehen.
Für die Abteilungen habe ich jeweils die aufgeführten Spalten verwendet, in denen die entsprechende E-Mail-Adresse steht
Leider funktioniert das ganze nicht.
Es klappt leider immernur wenn ich eine Mailadresse händisch hinter .to eingebe.
Kann mir hier jemand weiterhelfen?
Danke für Eure Hilfe.
habe hier eine Frage:
Ich habe vor unterschiedliche Abteilungen über einen Verteiler jeweils per Button zu versenden.
Da sich die Verteiler unterschiedlich zusammensetzen und es keine entspr. Verteiler in Outlook gibt, die gepflegt werden,
habe ich mir ein Blatt mit mehreren Abteilungen erstellt.
In diesem Fall (s.unten) soll die Mail an alle Abteilungen gehen.
Für die Abteilungen habe ich jeweils die aufgeführten Spalten verwendet, in denen die entsprechende E-Mail-Adresse steht
Leider funktioniert das ganze nicht.
Es klappt leider immernur wenn ich eine Mailadresse händisch hinter .to eingebe.
Kann mir hier jemand weiterhelfen?
Code:
Sub Bereichsdefinition()
Dim PP10 As Range
Dim PP12 As Range
Dim PP13 As Range
Dim PP14 As Range
Dim PP45 As Range
Dim PP46 As Range
Dim PP47 As Range
Dim PP53 As Range
Dim PP61 As Range
Dim PP62 As Range
Dim myMultiAreaRange_Gesamt As Range
Worksheets("E-Mail-Verteilerlisten").Activate
Set PP10 = Range("B3:B40")
Set PP12 = Range("D3:D40")
Set PP13 = Range("F3:F40")
Set PP14 = Range("H3:H40")
Set PP45 = Range("J3:J40")
Set PP46 = Range("L3:L40")
Set PP47 = Range("N3:N40")
Set PP53 = Range("P3:P40")
Set PP61 = Range("R3:R40")
Set PP62 = Range("T3:T40")
Set myMultiAreaRange_Gesamt = Union(PP10, PP12, PP13, PP14, PP45, PP46, PP47, PP53, PP61, PP62)
myMultiAreaRange.Select
End Sub
Sub Mail_workbook_Outlook_Gesamt()
'Die letzte gespeicherte Version wird verschickt
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "myMultiAreaRange_Gesamt" '.Text und .Value funktionieren nicht
.CC = ""
.BCC = ""
.Subject = "Änderung Datei"
.Body = "Anbei die geänderte Datei"
.Attachments.Add ActiveWorkbook.FullName
.Send 'oder nutze .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub