Option Explicit
Const MAX_CHARS = 20
Sub Test()
Call SendRangeWithOutlook(Selection)
End Sub
Private Sub SendRangeWithOutlook(rng As Excel.Range)
Dim ol As Outlook.Application
On Error Resume Next
Set ol = GetObject(, "outlook.application")
If ol Is Nothing Then _
Set ol = CreateObject("outlook.application")
If Not ol Is Nothing Then
Dim item As Outlook.MailItem: Set item = ol.CreateItem(olMailItem)
With item
.Subject = "Test-Mail"
.Body = RangeToText(rng)
.To = "test@test.de"
.Send
End With
Set item = Nothing
Set ol = Nothing
End If
End Sub
Private Function RangeToText(rng As Excel.Range, Optional Delimiter As String = vbTab) As String
Dim chars As String * MAX_CHARS
Dim result As String
Dim i&, j&
For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count
chars = rng(i, j)
result = result & chars & Delimiter
Next
result = Trim$(result) & vbCrLf
Next
RangeToText = result
End Function
Gruß
Thomas
Risi Thomas Softwareentwicklung
COM-Addins +++ RTD-Server +++ Komponenten
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen