Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1560to1564
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Text aus Textbox in E-Mail Body
01.06.2017 22:39:20
Oisse
Guten Abend zusammen,
ich möchte gerne aus einer TextBox mit Namen "E-Mailtext", die sich in dem Sheet "Newsletter" befindet per Makro als E-Mailtext in die zu erzeugenden E-Mails eintragen. Aber irgendwie komm ich da nicht hin.
Muss ich das als Shape ansprechen und wenn ja, wie krieg ich dann den Text?
Wie bitte muss der Code lauten?
Gruß Oisse

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Text aus Textbox in E-Mail Body
01.06.2017 23:51:37
Werner
Hallo,
hier mal ein kleines Beispiel. Text aus einem Textfeld in eine Variable auslesen und diese dann in einer MsgBox ausgeben.
Public Sub Test()
Dim strText As String
strText = Worksheets("Tabelle1").Shapes("E-Mailtext").TextFrame.Characters.Text
MsgBox strText
Gruß Werner
AW: Text aus Textbox in E-Mail Body
02.06.2017 06:24:40
Oisse
Hallo Werner,
danke für die klasse Antwort. Funktioniert. Dazu noch eine Frage: Kann man das so machen, dass die Zeilenumbrüche auch so übernommen werden wie in der TextBox?
Herzliche Grüße
Oisse
AW: Text aus Textbox in E-Mail Body
02.06.2017 12:23:46
Werner
Hallo,
das wird doch so übernommen wie im Textfeld dargestellt.
https://www.herber.de/bbs/user/113983.xlsm
Gruß Werner
Anzeige
AW: Text aus Textbox in E-Mail Body
02.06.2017 13:27:17
Oisse
Servus Werner,
irgend etwas läuft dann scheinbar schief bei mir. Nach der ersten Zeile macht er noch den Umbruch aber dann ist es damit vorbei. Irgendeine Idee woran das liegen könnte?
Vielen Dank für deine Beispielmappe und überhaupt für die tolle Hilfe.
Gruß Oisse
AW: Text aus Textbox in E-Mail Body
02.06.2017 16:17:14
Oisse
Nun bin ich´s nochmal.
Ich habe jetzt den Text, der später in der E-Mail angezeigt werden soll in ein separates Tabellenblatt in die Zelle "A1" gepackt. Dort auch entsprechend mit Zeilenumbruch.
Wenn ich nun diesen Code verwende

Set wks_Email = ThisWorkbook.Worksheets("Emailtext")
Emailtext = wks_Email.Range("A1").Text

wird der Text zwar eingefügt, aber ohne Zeilenumbruch.
Verwende ich diesen Code

Set wks_Email = ThisWorkbook.Worksheets("Emailtext")
Emailtext = wks_Email.Range("A1").Characters.Text

kommt die Fehlermeldung ´1004´ Anwendungs- oder objektdefinierter Fehler.
So sehr ich auch probiere - es funktioniert der Zeilenumbruch einfach nicht.
Könntest du nochmal helfen?
Gruß Oisse
Anzeige
AW: Text aus Textbox in E-Mail Body
02.06.2017 16:43:56
Werner
Hallo,
keine Ahnung ob ich dir da weiterhelfen kann. Aber auch andere Helfer werden da so ihre Probleme bekommen, weil es nicht zielführend ist nur ein paar Codezeilen zu zeigen. Da solltest du schon den kompletten Code zeigen, den du da aktuell am Start hast.
Gruß Werner
AW: Text aus Textbox in E-Mail Body
02.06.2017 17:22:39
Oisse
Danke für deine Antwort.
Ich stelle gerne den (sehr umfangreichen) Code rein. Hoffentlich ist er für euch übersichtlich genug.
Kurz erklärt passiert folgendes:
Aus dem Sheet "Newsletter" wird ein Worddokument gefüllt, das man noch abändern kann, bevor es als pdf gespeichert wird.
Dieses Pdf wird dann als Anhang an Emailempfänger gesandt. Diese Email soll eben den Text haben, der in der TextBox (war ja die erste Variante) oder in der Zelle "A1" steht (zweite Variante).
Hier also der Code:

Public Sub Newsletter()
'On Error GoTo Fehler
Dim WordObj As Object
Dim strPfad As String
Dim Datum As Date
Dim strAdress As String
Dim Text As String
Dim Aufseher As String
Dim eMailMA As String
Dim Ang As String
Dim CDateiName As String
Dim wks_Ang As Worksheet
Dim wks_Ein As Worksheet
Dim wks_Email As Worksheet
Dim Emailtext As String
Set wks_Ang = ThisWorkbook.Worksheets("Newsletter")
Set wks_Ein = Workbooks("Artikelliste.xlsm").Worksheets("Käuferadressen")
Emailtext = wks_Ang.Shapes("E-Mailtext").TextFrame.Characters.Text
'Set wks_Email = ThisWorkbook.Worksheets("Emailtext")
'Emailtext = wks_Email.Range("A1").Characters.Text
Datum = Date
Aufseher = wks_Ein.Cells(2, 12)
eMailMA = wks_Ang.Cells(13, 6)
'Die zwei Zellen, aus denen sich die Angebotsnummer zusammensetzt (Jahreszahl und fortlaufende  _
Nummer)
Ang = wks_Ang.Cells(16, 9)
'Die Speicheradresse und der Speichername mit Käufer, Angebotsnummer und Datum
CDateiName = ThisWorkbook.Path & "\NewsletterExtern\" & "  Newsletter Nr. " & Ang & "    " &  _
Datum & ".PDF"
On Error Resume Next
Set WordObj = GetObject(, "Word.Application")
If WordObj Is Nothing Then
Set WordObj = CreateObject("Word.Application")
Else
End If
WordObj.Documents.Add (ThisWorkbook.Path & "\Vorlagen\NewsletterExtern.docx")
WordObj.Visible = True
'Ab hier werden die einzelnen Zellen kopiert, und in die vorhandenen bookmards (Textmarken in  _
Word) mit den entspr. Namen eingefügt:
'Zellenbereich dynamisch ab Zeile 20 von Spalte A bis G kopieren, dies ist der Bereich in  _
dem die Artikel stehen mit Position und Stückzahl
lz = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
ActiveSheet.Range("A19:F" & lz).Copy
If WordObj.ActiveDocument.Bookmarks.Exists("Angebot") Then
WordObj.Selection.GoTo What:=-1, Name:="Angebot"  '-1 = wdGoToBookmark
WordObj.Selection.Paste
Application.CutCopyMode = False
WordObj.Selection.Tables(1).Rows(1).HeadingFormat = True
WordObj.Selection.Tables(1).Rows.LeftIndent = Application.CentimetersToPoints(-1)
End If
wks_Ang.Range("I16").Copy
If WordObj.ActiveDocument.Bookmarks.Exists("AngNr") Then
WordObj.ActiveDocument.Bookmarks("AngNr").Range = Ang
Else
MsgBox "Die Textmarke MarkeAngNr ist nicht vorhanden"
End If
ThisWorkbook.Sheets(wks_Ang).Range("I11").Copy
If WordObj.ActiveDocument.Bookmarks.Exists("Zeichen") Then
WordObj.ActiveDocument.Bookmarks("Zeichen").Range = wks_Ang.Range("I11").Value
Else
MsgBox "Die Textmarke MarkeZeichen ist nicht vorhanden"
End If
ThisWorkbook.Sheets(wks_Ang).Range("I12").Copy
If WordObj.ActiveDocument.Bookmarks.Exists("Durchwahl") Then
WordObj.ActiveDocument.Bookmarks("Durchwahl").Range = wks_Ang.Range("I12").Value
Else
MsgBox "Die Textmarke MarkeDurchwahl ist nicht vorhanden"
End If
ThisWorkbook.Sheets(wks_Ang).Range("I13").Copy
If WordObj.ActiveDocument.Bookmarks.Exists("Datum") Then
WordObj.ActiveDocument.Bookmarks("Datum").Range = wks_Ang.Range("I13").Value
Else
MsgBox "Die Textmarke MarkeDatum ist nicht vorhanden"
End If
If WordObj.ActiveDocument.Bookmarks.Exists("Angebot") Then
WordObj.ActiveDocument.Bookmarks("Angebot").Activate.Rows.HeadingFormat = wdToggle
Else
MsgBox "Die Textmarke MarkeAngebot ist nicht vorhanden"
End If
' With WordObj
' .ActiveDocument.SaveAs Filename:=CDateiName       'Als Word Dokument speichern
'End With
If MsgBox("Ändere ggf. das Word-Dokument ab und klicke danach hier OK", vbOKCancel, "Durchsicht  _
des Dokuments") = vbOK Then
'Als Pdf speichern
With WordObj
With .ActiveDocument
.ExportAsFixedFormat OutputFileName:=CDateiName, _
ExportFormat:=17, Openafterexport:=True, OptimizeFor:=0, _
Range:=0, From:=1, To:=1, _
Item:=0, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=0, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
.Close SaveChanges:=False
End With
End With
Else
WordObj.ActiveDocument.Close SaveChanges:=False
Exit Sub
End If
Rem Empfängerliste zusammenstellen
For i = 11 To wks_Ang.Range("L" & Rows.Count).End(xlUp).Row
If strAddress = "" Then
strAddress = wks_Ang.Cells(i, 12)
Else
strAddress = strAddress & ";" & wks_Ang.Cells(i, 12)
End If
Next i
Rem Email erstellen
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.GetInspector.Display
olOldBody = .htmlBody
'.To = strAddress
.CC = Aufseher & "; " & eMailMA
.BCC = strAddress
.Subject = "Newsletter" ' Betreff
.htmlBody = Emailtext
'              .htmlBody = "Sehr geehrte  _
Damen und Herren,
" & _ ' "anbei finden Sie eine Übersicht ausgewählter Artikel, welche zum _ Verkauf stehen.
" & _ ' "Sie interessieren sich für unsere Artikel? Kontaktieren sie uns _ telefonisch oder per Antwort auf diese E-Mail zur Terminabsprache, um zu einem beiderseits verbindlichen Angebot zu kommen.
" & _ ' "Sie können sich auch gerne selbst unter folgender Adresse nach _ vorheriger Vereinbarung diese und weitere Produkte ansehen.
" & _ ' "Bitte beachten Sie, dass die Artikel 'wie gesehen' angeboten werden. _ Daher können später keine Garantie oder mögliche Beanstandungen angezeigt werden.
" '& olOldBody Body. "
" = Zeilenumbruchanweisung" .Attachments.Add CDateiName 'Datei anhängen End With 'WordObj.Quit SaveChanges:=wdDoNotSaveChanges Set WordObj = Nothing wks_Ang.Visible = True End Sub

Danke dass du/ihr hilfst/helft.
Gruß Oisse
Anzeige
AW: Text aus Textbox in E-Mail Body
02.06.2017 17:25:06
Oisse
Häckchen vergessen. Sorry

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige