Thema: EMail versenden mit Voraussetzungen

Hallo zusammen,
ich habe ein kleines Problem.
Wir haben eine Liste in der alle Mitarbeiter, je nach Anwesenheit eingetragen werden.
Dies erfolgt von B9-B40 für das Team 1, C9-C40 für Team 2 usw.
Per Verweis wird je nach Team in den Spalten M-Q die entsprechende
Mailadresse aus einer Liste herausgesucht.
Nun soll (wie im Beispiel schon eingebaut) in jeder Zelle zwei Buttons (P und A)eingebaut werden, die je nachdem welchen man betätigt eine Mail mit bestimmen Inhalt versendet.
Problem 1 : Die Person in z.b. B9 ist nicht fest, sondert variiert je nach Anwesenheit, somit dann auch die Mailadresse in M9
Problem 2 : Da jede Person, die anwesend ist, eine EMail erhalten können soll (je nach Betätigung des Buttons eine andere), würde das, (mit meinen "Können") je Button ein Makro ergeben. Bei knappen 40 Teammitglieder und 5 Teams wäre das eine Wahnsinnige Flut an Makros.
Meine Makro für einen Button war bisher :

Sub Mail_1Asenden()
Dim strBetreff As String
Dim strBCC As String
Dim strInhalt As String
Dim strPfadAnhang As String
Dim zeile As Integer
Dim rAdressen As Range
strBetreff = Worksheets("Mailinhalte").Range("C3:C3").Value
strInhalt = Worksheets("Mailinhalte").Range("C6:C6").Value
zeile = ActiveCell.Row
Set obMail = CreateObject("Outlook.Application")
Set obNachricht = obMail.CreateItem(0)
With obNachricht
For Each rAdressen In Worksheets("Tabelle1").Range("M9")
If Not rAdressen.Value = "" Then
.Recipients.Add rAdressen.Value
End If
Next rAdressen
.Subject = strBetreff
.Body = strInhalt
.display  'Mail wird vorher noch angezeigt
.ReadReceiptRequested = False
'.send  ' Mail wird direkt verschickt
End With
Set obNachricht = Nothing
Set obMail = Nothing
End Sub

Die For Schleife habe ich noch drinnen, da dies eigentlich von einem anderen Makro stammte, welches mehrere EMails versenden sollte.
Aber irgendwie schaffe ich es nicht mein Makro anzupassen, dass es praktisch erkennt
in welcher Zeile ich den entsprechende Button gedrückt habe um dann die passende Mailadresse auszuwählen und die Mail zu versenden und das noch so, dass ich nicht für jeden P und A Button in jeder Zelle, ein extra Makro habe.
Als Beispiel :
In B9 ist Max Mustermann eingetragen, per Verweis in M9 die dazu passende Mailadresse.
Drücke ich nun den P-Button soll Max eine Mail mit dem Inhalt XY erhalten, drücke ich nun den A-Button, soll Max eine Mail mit dem Inhalt ZZ erhalten.
Steht nun in B10 Frau Mustermann, soll dies bei ihr ebenfalls möglich sein...
Also in B10 je ein P und A Button und dieser soll dann jeweils auf den gleichen Inhalt wie bei Max verweisen und die Mail senden....
Ich hoffe, ich habe mich halbwegs verständlich ausgedrückt. ;-)
Auch muss ich gleich vorwarnen, dass ich so richtig erst ab Montag wieder hier reinschauen kann um entsprechende Antworten auf Fragen zu geben.
Bedanke mich jetzt schon mal für eure Hilfe und bin für jeden Vorschlag offen.
Beispieldatei :
https://www.herber.de/bbs/user/98894.xlsx
Viele Grüße
Toumas

Hallo Rudi,
ich habe nur einfach die Mappe so kopiert, da noch extrem viel mehr Code in der ganzen Datei hinterlegt ist und hatte gehofft, dass es zur Verdeutlichung des Problems ausreicht....

hallo,
weise allen Buttons 'Aufruf' zu.

Sub Aufruf()
Dim c As Shape
Set c = ActiveSheet.Shapes(Application.Caller)
Select Case c.DrawingObject.Caption
Case "A": Mail_1Asenden c.TopLeftCell.Row
Case "P": Mail_1Psenden c.TopLeftCell.Row
End Select
End Sub

Sub Mail_1Asenden(lRow As Long)
Dim strBetreff As String
Dim strBCC As String
Dim strInhalt As String
Dim strPfadAnhang As String
Dim rAdressen As Range
Dim obMail As Object, obNachricht As Object
strBetreff = Worksheets("Mailinhalte").Range("C3:C3").Value
strInhalt = Worksheets("Mailinhalte").Range("C6:C6").Value
Set obMail = CreateObject("Outlook.Application")
Set obNachricht = obMail.CreateItem(0)
With obNachricht
.To = Worksheets("Tabelle1").Cells(lRow, 9)
.Subject = strBetreff
.Body = strInhalt
.display  'Mail wird vorher noch angezeigt
.ReadReceiptRequested = False
'.send  ' Mail wird direkt verschickt
End With
Set obNachricht = Nothing
Set obMail = Nothing
End Sub

Gruß
Rudi

Hallo Rudi,
danke vielmals für deine Mühen,
soweit klappt es auch recht gut, aber irgendwie übernimmt das Makro die Mailadressen aus
der Spalte M nicht......
Viele Grüße
Toumas

Hi Rudi,
hab es noch mal versucht..... Aber wie gesagt, er übernimmt mir nicht die Mailadressen aus der Spalte M.
Wenn ich in Spalte B9 auf den Button drücke, sollte er mir die Mailadresse aus M9 nehmen..
Wenn ich in Spalte B10 den Button drücke, so sollte er mir die Adresse aus M10 nehmen...
ich vermute, ich hab mich unklar ausgedruckt bei meinem ersten Posting.....
Viele Grüße
Toumas

Hallo zusammen,
ich habe ein kleines Problem.
Wir haben eine Liste in der alle Mitarbeiter, je nach Anwesenheit eingetragen werden.
Dies erfolgt von B9-B40 für das Team 1, C9-C40 für Team 2 usw.
Per Verweis wird je nach Team in den Spalten M-Q die entsprechende
Mailadresse aus einer Liste herausgesucht.
Nun soll (wie im Beispiel schon eingebaut) in jeder Zelle zwei Buttons (P und A)eingebaut werden, die je nachdem welchen man betätigt eine Mail mit bestimmen Inhalt versendet.
Problem 1 : Die Person in z.b. B9 ist nicht fest, sondert variiert je nach Anwesenheit, somit dann auch die Mailadresse in M9
Problem 2 : Da jede Person, die anwesend ist, eine EMail erhalten können soll (je nach Betätigung des Buttons eine andere), würde das, (mit meinen "Können") je Button ein Makro ergeben. Bei knappen 40 Teammitglieder und 5 Teams wäre das eine Wahnsinnige Flut an Makros.
Meine Makro für einen Button war bisher :

Sub Mail_1Asenden()
Dim strBetreff As String
Dim strBCC As String
Dim strInhalt As String
Dim strPfadAnhang As String
Dim zeile As Integer
Dim rAdressen As Range
strBetreff = Worksheets("Mailinhalte").Range("C3:C3").Value
strInhalt = Worksheets("Mailinhalte").Range("C6:C6").Value
zeile = ActiveCell.Row
Set obMail = CreateObject("Outlook.Application")
Set obNachricht = obMail.CreateItem(0)
With obNachricht
For Each rAdressen In Worksheets("Tabelle1").Range("M9")
If Not rAdressen.Value = "" Then
.Recipients.Add rAdressen.Value
End If
Next rAdressen
.Subject = strBetreff
.Body = strInhalt
.display  'Mail wird vorher noch angezeigt
.ReadReceiptRequested = False
'.send  ' Mail wird direkt verschickt
End With
Set obNachricht = Nothing
Set obMail = Nothing
End Sub

Die For Schleife habe ich noch drinnen, da dies eigentlich von einem anderen Makro stammte, welches mehrere EMails versenden sollte.
Aber irgendwie schaffe ich es nicht mein Makro anzupassen, dass es praktisch erkennt
in welcher Zeile ich den entsprechende Button gedrückt habe um dann die passende Mailadresse auszuwählen und die Mail zu versenden und das noch so, dass ich nicht für jeden P und A Button in jeder Zelle, ein extra Makro habe.
Als Beispiel :
In B9 ist Max Mustermann eingetragen, per Verweis in M9 die dazu passende Mailadresse.
Drücke ich nun den P-Button soll Max eine Mail mit dem Inhalt XY erhalten, drücke ich nun den A-Button, soll Max eine Mail mit dem Inhalt ZZ erhalten.
Steht nun in B10 Frau Mustermann, soll dies bei ihr ebenfalls möglich sein...
Also in B10 je ein P und A Button und dieser soll dann jeweils auf den gleichen Inhalt wie bei Max verweisen und die Mail senden....
Ich hoffe, ich habe mich halbwegs verständlich ausgedrückt. ;-)
Auch muss ich gleich vorwarnen, dass ich so richtig erst ab Montag wieder hier reinschauen kann um entsprechende Antworten auf Fragen zu geben.
Bedanke mich jetzt schon mal für eure Hilfe und bin für jeden Vorschlag offen.
Beispieldatei :
https://www.herber.de/bbs/user/98894.xlsx
Viele Grüße
Toumas

Hallo Rudi,
ich habe nur einfach die Mappe so kopiert, da noch extrem viel mehr Code in der ganzen Datei hinterlegt ist und hatte gehofft, dass es zur Verdeutlichung des Problems ausreicht....

hallo,
weise allen Buttons 'Aufruf' zu.

Sub Aufruf()
Dim c As Shape
Set c = ActiveSheet.Shapes(Application.Caller)
Select Case c.DrawingObject.Caption
Case "A": Mail_1Asenden c.TopLeftCell.Row
Case "P": Mail_1Psenden c.TopLeftCell.Row
End Select
End Sub

Sub Mail_1Asenden(lRow As Long)
Dim strBetreff As String
Dim strBCC As String
Dim strInhalt As String
Dim strPfadAnhang As String
Dim rAdressen As Range
Dim obMail As Object, obNachricht As Object
strBetreff = Worksheets("Mailinhalte").Range("C3:C3").Value
strInhalt = Worksheets("Mailinhalte").Range("C6:C6").Value
Set obMail = CreateObject("Outlook.Application")
Set obNachricht = obMail.CreateItem(0)
With obNachricht
.To = Worksheets("Tabelle1").Cells(lRow, 9)
.Subject = strBetreff
.Body = strInhalt
.display  'Mail wird vorher noch angezeigt
.ReadReceiptRequested = False
'.send  ' Mail wird direkt verschickt
End With
Set obNachricht = Nothing
Set obMail = Nothing
End Sub

Gruß
Rudi

Hallo Rudi,
danke vielmals für deine Mühen,
soweit klappt es auch recht gut, aber irgendwie übernimmt das Makro die Mailadressen aus
der Spalte M nicht......
Viele Grüße
Toumas

Hi Rudi,
hab es noch mal versucht..... Aber wie gesagt, er übernimmt mir nicht die Mailadressen aus der Spalte M.
Wenn ich in Spalte B9 auf den Button drücke, sollte er mir die Mailadresse aus M9 nehmen..
Wenn ich in Spalte B10 den Button drücke, so sollte er mir die Adresse aus M10 nehmen...
ich vermute, ich hab mich unklar ausgedruckt bei meinem ersten Posting.....
Viele Grüße
Toumas