E-Mail aus Excel VBA
08.08.2016 11:42:36
Marsl
habe hier einen Code, der mir von Spalte B- n die zweite Zeile in Outlook kopiert und es an die Empfänger per Mail schickt
Also B1 bekommt Info B2// C1, bekommt Info C2 etc...
Ich müsste jetzt noch bei jedem Emfänger einen Bereich A1 - A5 einfügen. Dieser ist bei allen gleich. Soll auch vom Format her gleich sein wie in Excel.
Jemand ne Idee wie man das einbindet? Hier der Code
Sub Excel_StundenPerMail()
'Dim ClpObj As DataObject
'Outlook-Objekte
Dim OutApp As Object, Mail As Object
Dim Nachricht
Dim varEmpf, strBody As String
Dim wks As Worksheet, rngData As Range
Dim Spalte As Long, Spalte_L As Long, Zeile_L As Long
Set wks = ActiveSheet
Set OutApp = CreateObject("Outlook.Application")
Set ClpObj = New DataObject
With wks
'letzter Empfänger in Zeile 5
Spalte_L = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Spalte = .Range("B1").Column To Spalte_L Step 1
Zeile_L = .Cells(.Rows.Count, Spalte).End(xlUp).Row
varEmpf = .Cells(1, Spalte).Text
If Zeile_L >= 1 Then
'Datenbereich für E-Mail ab Zeile 2 setzen
Set rngData = .Range(.Cells(2, Spalte), .Cells(Zeile_L, Spalte))
'Bereich wird in die Zwischenablage kopiert
rngData.Copy
ClpObj.GetFromClipboard
strBody = ClpObj.GetText(1)
Else
Set rngData = Nothing
strBody = "keine Nachrichten"
End If
'Nachricht erstellen in Outlook
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.Subject = "TESTMAIL"
'Zwischenablage wird eingefügt
.Body = strBody
.To = varEmpf
'Hier wird die Mail angezeigt
'.Display
'Hier wird die Mail gleich in den Postausgang gelegt
.Send
End With
'Auf Outlook warten.
Application.Wait (Now + TimeSerial(0, 0, 2)) '2 Sekunden Wartezeit
Set Nachricht = Nothing
Next Spalte
Set OutApp = Nothing
End With
End Sub