Excel Tabelle in Outlook einfügen

[Pitty-xx]

Hallo zusammen,

ich beschäftige mich schon seit einiger Zeit mit Excel, doch an die VBA Programmierung habe ich mich noch nicht herangetraut. Nun habe ich schon einige Sachen probiert, geklappt hat es aber noch nicht.
Nun zu meinem Vorhaben:
Ich möchte ein Excel Dokument mit zwei jpg´s in Outlook einfügen und dann versenden.
Natürlich sollten auch die Formatierungen übernommen werden.


1. Der Bereich der kopiert werden soll ist A33:H87
2. In der Empfängerzeile „AN:“ sollen zwei Empfänger stehen
3. In der CC Zeile „CC“ noch zwei Empfänger
4. Die Betreffzeile soll sich so zusammensetzen:
      „Text1“ Inhalt aus Zelle D42 und „Text2“ Inhalt aus Zelle D41 und „Text3“ aus Zelle H41


Natürlich möchte ich dieses mit einem Button „Kopieren und Einfügen“ mit einem Klick abschließen!!


Freue mich schon auf Eure Hilfen und Tricks.

Dankeschön im Voraus

Peter

[Case]

Hallo,

mal als Ansatz:

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("A1:C11").Copy
    With objOutApp
        .Display
        .To = "a@b.de; c@d.de"
        .CC = "e@f.de; g@h.de"
        .Subject = "Ihre Anfrage..."
        .Attachments.Add "C:\Temp\Test.png"
        .Attachments.Add "C:\Temp\A_2.jpg"
        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

Wenn du dir den Code anschaust, siehst du ganz leicht, wo du anpassen musst, um deine Wünsche zu erfüllen.

[Pitty-xx]

Hallo Case,

danke für die schnelle Antwort. 

Ich werde es später mal ausprobieren.

---

Leider hat es noch nicht so geklappt. Einige Punkte wurden schon erledigt.

1. Der Bereich der kopiert werden soll ist A33:H87 / offen
2. In der Empfängerzeile „AN:“ sollen zwei Empfänger stehen / erledigt
3. In der CC Zeile „CC“ noch zwei Empfänger / erledigt
4. Die Betreffzeile soll sich so zusammensetzen:
      „Text1“ Inhalt aus Zelle D42 und „Text2“ Inhalt aus Zelle D41 und „Text3“ aus Zelle H41 / offen


Der Rest funktioniert aber schon

Es wird langsam...

[Steffl]

Auch Hallo,

4. Die Betreffzeile soll sich so zusammensetzen:
      „Text1“ Inhalt aus Zelle D42 und „Text2“ Inhalt aus Zelle D41 und „Text3“ aus Zelle H41 / offen

mal ungetestet

Code:

.Subject = "Ihre Anfrage... " & Range("D42").Value & " und " & Range("D41").Value & " und auch das noch " & Range("H41").Value

[Pitty-xx]

Hey Stefan,

super, läuft prima. So soll es sein.

Neuer Status:

1. Der Bereich der kopiert werden soll ist A33:H87 / offen
2. In der Empfängerzeile „AN:“ sollen zwei Empfänger stehen / erledigt
3. In der CC Zeile „CC“ noch zwei Empfänger / erledigt
4. Die Betreffzeile soll sich so zusammensetzen:
      „Text1“ Inhalt aus Zelle D42 und „Text2“ Inhalt aus Zelle D41 und „Text3“ aus Zelle H41 / erledigt



Was ich auch noch hinbekommen habe, dem Makro einem "Button" oder so zuzuweisen.

[Case]

Hallo,

passe hier,...

Code:

ThisWorkbook.Worksheets("Tabelle1").Range("A1:C11").Copy

... wenn nötig, den Tabellenblattnamen und den Range an.

[Pitty-xx]

Hallo Case,

das habe ich schon angepasst. Leider wird nichts kopiert. Auch der Teil mit "Sehr geehrte Damen und Herren".... fehlt und wird nicht kopiert.

Ich habe mal eine Testdatei angefügt.

[Case]

Hallo,

dann ist bei dir in den Optionen eingestellt, dass Mails im Textformat verfasst werden. Probiere es so:

Code:

'........
ThisWorkbook.Worksheets("Test_Datei").Range("A33:H87").Copy
With objOutApp
    .BodyFormat = 2
    .Display
'........

Das stellt das BodyFormat auf "HTML" um.

[Pitty-xx]

Hallo Case,

erstmal DANKE DANKE für deine Bemühungen.

Ich habe es gerade in der Testdatei angepasst, nix tut sich.

In Outlook ist auch eingestellt, Email im HTML Format verfassen

Gruß

Peter

[Case]

Hallo,

dann nehmen wir "RangetoHTML" von Ron de Bruin:

  Excel_Outlook_Range_in_Body.xlsb (Größe: 43,59 KB / Downloads: 9)

Probiere mal den kleinen Button, wo "Mail..." draufsteht.