Email senden Excel

[diving_excel]

Guten Morgen!
Ich habe eine Frage zu einem VBA Code der mir per Klick auf eine Schaltfläche eine bestimmte Email versendet. Ich möchte zu jeder Zeile, einen "senden" Button haben, der abhängig von bestimmten Zellen bestimmte Texte in die Mail einfügt und den Betreff anpasst. 

Grundsätzlich ist das ja kein Problem wenn man das nur für eine Zeile machen möchte, jetzt hab ich aber ca 100 Zeilen für die ich das machen will und mir fällt momentan nur die Lösung ein für jede Zeile quasi ein eigenes Modul zu erstellen und dann das jeweilige Modul zur jeweiligen Schaltfläche zuzuordnen; in etwa so:

1. Zeile:

Code:

Sub EmailDirektSenden1()

Dim objOutlook As Object
Dim objMail As Object

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
   .To = Range("C2").Value
   .Subject = Range("E2").Value
   .Body = Range("B2").Value
   .CC = Range("D2").Value
   .display
End With

End Sub

2. Zeile

Code:

Sub EmailDirektSenden2()

Dim objOutlook As Object
Dim objMail As Object

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
  .To = Range("C3").Value
  .Subject = Range("E3").Value
  .Body = Range("B3").Value
  .CC = Range("D3").Value
  .display
End With

End Sub

3. Zeile 

Code:

Sub EmailDirektSenden3()

Dim objOutlook As Object
Dim objMail As Object

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
  .To = Range("C4").Value
  .Subject = Range("E4").Value
  .Body = Range("B4").Value
  .CC = Range("D4").Value
  .display
End With

End Sub

.... usw... bis Zeile 100.

Ich bin mir sicher es gibt einen besseren Weg, als jetzt zu jeder Zeile ein neues Modul zu erstellen und dann die entsprechende Schaltfläche zuzuordnen.

Bin über jeden Input dankbar!

Gruß 


  Mail Test mit Makro.xlsm (Größe: 18,85 KB / Downloads: 1)


  Mail Test ohne Makro.xlsx (Größe: 12,44 KB / Downloads: 0)

[Steffl]

Hallo,

versuch mal so (jeden Button das Gleiche Makro zuweisen)

Code:

Sub EmailDirektSenden1()

Dim objOutlook As Object
Dim objMail As Object
Dim lngZeile As Long

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
lngZeile = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row

With objMail
   .To = Cells(lngZeile, 3).Value
   .Subject = Cells(lngZeile, 5).Value
   .Body = Cells(lngZeile, 2).Value
   .CC = Cells(lngZeile, 4).Value
   .display
End With

End Sub

[diving_excel]

Vielen Dank! Funktioniert perfekt!