Bereich einer Excel Tabelle als Email versenden

[peterpan5]

Hallo zusammen,

für euch ist dies wahrscheinlich eine Kleinigkeit, aber trotz google bekomme ich es aktuell nicht hin.
Bestimmte Bereiche aus einem Excel-Sheet sollen in einer Email verschickt werden.

Folgendes habe ich bereits hinbekommen und zumindest der Betreff weist das entsprechende Feld aus:

Code:

Sub EmailManuellAbsenden()

Dim objOutlook As Object
Dim objMail As Object

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

With objMail
  .To = "test@test.de"
  .Subject = Range("B1")
  .Body = Range("B1")
  .Display        'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend manuell vom User!
End With
End Sub

Im Textfeld der Email soll der Bereich von A2 bis C11 als Tabelle angezeigt werden.
Vielen Dank!!!

[snb]

Schau mal:

https://www.snb-vba.eu/VBA_Excelgegevens...ml#L_2.3.7

[peterpan5]

wird hier nicht eine Datei an die Email angehangen?

[Case]

Hallo, :19:

probiere es mal so: :21:

Code:

Option Explicit
Public Sub Main()
    Const wdTableAppendTable = 10
    Const wdCollapseEnd = 0
    Dim objWordDoc As Object
    Dim objOutApp As Object
    Dim obgRange As Object
    Dim strTMP As String
    On Error GoTo Fin
    Application.ScreenUpdating = False
    Set objOutApp = CreateObject("Outlook.Application").CreateItem(0)
    ThisWorkbook.Worksheets("Tabelle1").Range("A2:C11").Copy
    With objOutApp
        .Display
        .To = "a@b.de"
        .CC = "c@d.de"
        .subject = "Ihre Anfrage..."
        strTMP = .HTMLBody
        Set objWordDoc = .GetInspector.WordEditor
        objWordDoc.Content = "Sehr geehrte Damen und Herren," & vbCrLf & vbCrLf & _
        "Infos folgen..." & vbCrLf & vbCrLf & _
        "Viele Grüße" & vbCrLf & "Der Chef" & vbCrLf & vbCrLf
        Set obgRange = objWordDoc.Range
        obgRange.Collapse Direction:=wdCollapseEnd
        obgRange.PasteAndFormat (wdTableAppendTable)
        .HTMLBody = .HTMLBody & strTMP
    End With
Fin:
    Application.ScreenUpdating = True
    Set obgRange = Nothing
    Set objWordDoc = Nothing
    Set objOutApp = Nothing
    Application.CutCopyMode = False
End Sub

Anpassungen nicht vergessen (z. B. Tabellenblattname).

[CHASiN1994]

Code:

Option Explicit

Sub Mail_senden()

Dim Mailadresse As String, Betreff As String
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")

Betreff = "Mail"
With olApp.CreateItem(0)
.To = "hi@me.de"
.Subject = "Mail"
.body = "Guten Tag zusammen," & Chr(13) & _
Chr(13) & _
Sheets("Mail").Range("A3") & Chr(13) & Chr(13) & _
Sheets("Mail").Range("A4") & Chr(13) & Chr(13) & _
Sheets("Mail").Range("A6") & Chr(13) & Chr(13) & _
Sheets("Mail").Range("A7") & Chr(13) & Chr(13) & _
Sheets("Mail").Range("A8") & Chr(13) & Chr(13) & _
Sheets("Mail").Range("A10") & Chr(13) & Chr(13) & _
Sheets("Mail").Range("A11") & Chr(13) & Chr(13) & _
Sheets("Mail").Range("A12") & Chr(13) & Chr(13) & _
""


.Display

End With
Set olApp = Nothing

End Sub

Habe mal alles In Mail genannt. Beispiel Sheets("Mail".Range("A3) &... heißt im Prinzip aus dem Tabellenblatt (Sheet) mit dem Namen Mail den Inhalt aus Zelle A3..