Email an CC Verteiler
27.04.2009 08:03:34
Alex
ich habe eine Arbeitsmappe, wo nach Auswahl einer Firma die Arbeitsmappe an diese gesendet wird. Hierfür habe ich dann ein Tabellenblatt "Parameter" wo die E-Mailadressen der Empfänger hinterlegt sind.
Die VBA holt sich dann aus dem Tabellenblatt die nötige Emailadresse für die Versendung.
Jetzt möchte ich gerne noch eine Änderung der Versendung und ich bekomme einfach keine Lösung hin. Hoffentlich könnt ihr mir weiterhelfen. Und zwar möchte ich gerne, wenn ich die Emailadresse von Firma1 auswähle und sende, dass die Firma2 die gleiche Email erhält als CC empfänger.
Hatte schon versucht im Tabellenblatt "Parameter" zwei Emailadressen in eine Zelle zu schreiben, erhalte dann immer einen Fehler.
Vielen Dank für Eure hilfe.
Hier die VBA der Versendung:
Sub EMail_senden()
Application.ScreenUpdating = False ' Bildschirmaktualisierung Aus
EMail_Firma1 = Sheets("Parameter").Range("H13").Text
EMail_Firma2 = Sheets("Parameter").Range("H14").Text
Sheets("Selektion").Select
Region = Range("B6")
Sheets("BLV 40 Aufmaß").Select
Select Case Region
Case "T1S": Pfad_Daten = Sheets("Parameter").Range("L2").Text: Pfad_Ablage = Sheets("Parameter") _
.Range("P2").Text
Case "T2S": Pfad_Daten = Sheets("Parameter").Range("L3").Text: Pfad_Ablage = Sheets("Parameter") _
.Range("P3").Text
Case "T3S": Pfad_Daten = Sheets("Parameter").Range("L4").Text: Pfad_Ablage = Sheets("Parameter") _
.Range("P4").Text
Case "T4S": Pfad_Daten = Sheets("Parameter").Range("L5").Text: Pfad_Ablage = Sheets("Parameter") _
.Range("P5").Text
Case "TAS": Pfad_Daten = Sheets("Parameter").Range("L6").Text: Pfad_Ablage = Sheets("Parameter") _
.Range("P6").Text
End Select
Call Blocksatznummer ' Blocksatznummer wird aus Datei geholt _
und ins
' Formular eingetragen
Call Blocksatznummer_speichern ' Blocksatznummer wird aus Formular _
gelesen und
' in Datei gespeichert
Firma = Range("B16").Value ' Die Formel in der Unternehmerzelle _
durch den Wert ersetzen
Range("B16") = Firma
' Datei vor dem Versand speichern
Application.DisplayAlerts = False ' ist nötig um die Bestätigungsabfrage _
beim nachfolgenden
' Blatt löschen zu unterdrücken.
ActiveSheet.Unprotect ("dbl") ' Blattschutz aufheben
ActiveSheet.Shapes("Button 5").Select ' Versendebutton auswählen
Selection.Delete ' Versendebutton löschen
' Blattschutz _
aktivieren
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True
' Unternehmer aus Formular auslesen
Select Case Firma ' EMail-adresse zum Unternehmer _
ermitteln
Case "Firma1": EMAILADR = EMail_Firma1
Case "Firma2": EMAILADR = EMail_Firma2
If Sheets("Parameter").Range("J13") = "x" Or Sheets("Parameter").Range("J13") = "X" Then _
EMAILADR = EMail_Dummy
End Select ' Ergebnis : EMail-adresse steht in _
Variable EMAILAdr
Sheets("Selektion").Select ' Blätter Selektion und Parameter vor _
Versand löschen
ActiveWindow.SelectedSheets.Delete
Sheets("Parameter").Select
ActiveWindow.SelectedSheets.Delete
Sheets("BLV 40 Aufmaß").Select
Application.DisplayAlerts = True ' schaltet die Bestätigungen wieder ein. _
ActiveWorkbook.SaveAs Filename:=Pfad_Ablage & BLV & " " & blocksatznr & " " & baustelle & " _
.xls"
' EMail zusammenbasteln und versenden
ThisWorkbook.HasRoutingSlip = True
ThisWorkbook.RoutingSlip.Delivery = xlOneAfterAnother
ThisWorkbook.RoutingSlip.Recipients = EMAILADR
ThisWorkbook.RoutingSlip.Subject = baustelle & " / " & tätigkeit
ThisWorkbook.RoutingSlip.Message = "Neue Beauftragung von " & Region & " siehe Anlage"
ThisWorkbook.RoutingSlip.ReturnWhenDone = False
ThisWorkbook.Route
ThisWorkbook.HasRoutingSlip = False
ThisWorkbook.Close (False)
Application.ScreenUpdating = True ' Bildschirmaktualisierung Ein
Excel.Application.Quit ' Excel beenden
End Sub