Mailversenden - Teil II
20.07.2015 09:12:55
Toumas
am Freitag war Rudi bereits so nett und hat mir ein tolles Makro zur Verfügung gestellt.
So weit funktioniert es auch recht gut, nur habe ich das Problem, dass das Makro
die Mailadressen nicht im Outlook übernimmt.
Es ist so, dass ich z.b. in B9 zwei Buttons habe, einen mit A und den anderen mi der Bezeichnung P, drücke ich nun einen der Buttons, erkennt das Makro welchen
und öffnet mir eine EMail an den jeweiligen Mitarbeiter.
Die Mailadresse befindet sich entsprechend in M9 (wenn ich in B9 die Buttons drücke) oder M10 usw.... Also Button B9 => Mailadresse M9, Button B10 => Mailadresse B10 usw.
Irgendwie erkennt das Makro nicht, in welcher Zelle ich den Button gedrückt habe um dann die entsprechende Mailadresse auszulesen und zu übernehmen....
Ich vermute mal, dass ich das Makro von Rudi irgendwie falsch eingesetzt habe, da Makro nur mit Recorder...
vielleicht kann mir Rudi, oder jemand von den anderen Profis mal nen Tipp geben, auf was ich dabei genauer achten sollte..
Anbei das Makro von Rudi, welches ich nun an meine Liste angepasst habe :
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("Übersicht Telefonbereitschaft").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
vielen Dank im Voraus...
Viele Grüße
Toumas