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
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.
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...
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.
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.
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.
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