Text 1:1 Kopieren

Guten Tag
Ich möchte einen Text aus einem Word Dokument 1:1 Kopieren und in Outlook wieder einfügen. In meinem Dokument habe ich Tabulatoren gesetzt. Diese werden jedoch nicht mit unterstehenden Code Kopiert und Eingefügt. Gibt es da vielleicht eine Lösung?
Wäre es auch möglich über VBA die Signatur zu bestimmen?
Besten Dank für Eure Unterstützug.
Gruss Daniel E.


Sub WordDateiBearbeiten()
'Allgemein
Dim strSuchbegriff_Anfang     As String
Dim strSuchbegriff_Ende       As String
Dim QuellDatei As Workbook
Set QuellDatei = Workbooks("Versuch003")
'Word
Dim ObjWinWord                As Object
Dim ObjDocWord                As Object
Const wdWindowStateMaximize   As Long = 1
'Word-Ranges, keine Excel-Ranges!
Dim rngA                      As Object
Dim rngE                      As Object
Dim rngFound                  As Object
'Suchbegriffe für Anfang und Ende vorgeben!
strSuchbegriff_Anfang = "Hallo da draussen!"
strSuchbegriff_Ende = "Garage Eberhard GmbH"
Set ObjWinWord = CreateObject("Word.Application")
ObjWinWord.Visible = True
ObjWinWord.WindowState = wdWindowStateMaximize
ObjWinWord.Activate
'Adresse zu Hause
'    Set ObjDocWord = ObjWinWord.Documents.Open("C:\Users\Nathi Noel Dänu\Dropbox\VBA\E-mail\Text001.docx")
'Adresse GmbH
Set ObjDocWord = ObjWinWord.Documents.Open("C:\Users\User\Dropbox\VBA\E-mail\Text001.docx")
Set rngA = ObjDocWord.Content
Set rngE = ObjDocWord.Content
Set rngFound = ObjDocWord.Content
rngA.Find.Execute FindText:=strSuchbegriff_Anfang
rngE.Find.Execute FindText:=strSuchbegriff_Ende
rngFound.SetRange rngA.End, rngE.Start
rngFound.Copy
ObjDocWord.Close
ObjWinWord.Quit
Set ObjDocWord = Nothing
Set ObjWinWord = Nothing
End Sub
Sub EmailDirektSenden()
Dim QuellDatei As Workbook
Dim OutApp As Object, Mail As Object, i
Dim Nachricht
Set QuellDatei = Workbooks("Versuch003")
'Verweis auf "Microsoft Forms 2.0 Object Library" aktivieren !!
'sonst geht es nicht
'Dataobject wird gebraucht wegen der Zwischenablage
Dim ClpObj As DataObject
Set ClpObj = New DataObject
Set OutApp = CreateObject("Outlook.Application")
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.Subject = "Betreffzeile Header"
'Zwischenablage wird eingefügt
ClpObj.GetFromClipboard
.Body = ClpObj.GetText(1)
.To = "info@degarage.ch"
'Hier wird die Mail angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'        .Send
End With
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Test() Dim dateiname As String Dim i As Long Dim ObjWinWord As Object Dim ObjDocWord As Object Const wdWindowStateMaximize As Long = 1 Dim strTextInDoc As String Dim strTextGefunden As String Dim strSuchbegriff_Anfang As String Dim strSuchbegriff_Ende As String 'Suchbegriffe für Anfang und Ende vorgeben! strSuchbegriff_Anfang = "Hallo da draussen!" strSuchbegriff_Ende = "Garage Eberhard GmbH" Set ObjWinWord = CreateObject("Word.Application") ObjWinWord.Visible = True ObjWinWord.WindowState = wdWindowStateMaximize ObjWinWord.Activate Set ObjDocWord = ObjWinWord.Documents.Open("C:\Users\User\Dropbox\VBA\E-mail\Text001.docx") strTextInDoc = ObjDocWord.Content.Text strTextGefunden = Trim$(Split(Split(strTextInDoc, strSuchbegriff_Anfang)(1), strSuchbegriff_Ende)(0)) Set ObjDocWord = Nothing Set ObjWinWord = Nothing Dim objOutlook As Object Dim objMail As Object Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) With objMail .To = "deinname@deinedomain.de" .Subject = "Betreff" .Body = strTextGefunden .Display ' .Send 'Sendet die Email automatisch End With End Sub

Hallo Daniel,
ich habe mal einen eigenen Weg kreiert, den Teil eines Word-Dokumentes in Outlook einzufügen und sende Dir eine Zip-Datei mit einer Word-Datei. Mit dem Dokument ist ein Makro verbunden. Dies solltest Du jedoch kopieren auf "Normal" - "NewMakros". Die Normal-Makros werden zentral für alle ".docm"-Dateien geführt. Wenn dort bei Dir schon die Makros1 - 4 vergeben sind, bitte die Makronumern - vor dem Kopieren - im Dokument auf andere Nummern ändern (auch den Call ändern!). Die Rubrik für Normal-Makros findest Du nach Aufruf von Makro1 zur Bearbeitung im Projekt-Fenster oben links. Erst danach ist das Verfahren mit allen Word-Dokumenten möglich.
Am Anfang des Dokuments so wie auf dem Muster "Meister_Eder.docm" dargestellt, die E-Mail-Adresse des Empfängers eintragen. Die Zeilen "E-Mail-Empfänger" und "Betreff" sind vom Inhalt her obligatorisch. Nach der Zeile "Betreff" kommt der Betreff für die E-Mail. Zwischen den Zeilen 1 x die Eingabetaste betätigen. Vor dem in die E-Mail einzufügenden Text ist die Zeile "E-Mail-Text" obligatorisch einzufügen; danach 1 x die Eingabetaste betätigen. Am Ende des einzufügenden Textes 2 x die Eingabetaste betätigen und den obligatorischen Text "Ende E-Mail-Text" eingeben.
Die Grußformel kannst Du in Outlook - auch mehrere - festlegen. Für neue Nachrichten kann man den Parameter "ohne" auswählen und anschließend die gewünschte Grußformel einfügen. Dafür braucht es keinen Makro in Word.
Hier die Word-Datei
https://www.herber.de/bbs/user/149079.zip
Übrigens: Dein Thread läuft heute nacht ab! Bei Rückfragen kannst Du mich gerne privat anschreiben, zumal sich hier im Excel-Forum für Word- und Outlook-Probleme kaum jemand interessiert.
Bitte mal ausprobieren; Rückmeldung wäre nett.
Mit freundlichem Gruß
Peter Kloßek
PS Habe soeben bemerkt, dass das Dokument auch die Makros 1000 und 1010 enthält. Bitte diese einfach löschen, sind irrtümlich mit hineingeraten.

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread