Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1396to1400
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
Inhaltsverzeichnis

Email mit zwei vorangestellten Leerzeilen

Email mit zwei vorangestellten Leerzeilen
07.12.2014 19:36:49
DirkR

Hallo Excelgemeinde!
Ich habe folgendes Problem und brauche Hilfe!
Ich kopiere einen Bereich aus einem Arbeitsblatt und füge diesen Bereich in eine neue EMail ein.
Nun hätte ich aber gerne, dass bei der neuen Mail erst 2 Zeilen Leer sind und dann der Bereich eingefügt wird. Das bekomme ich aber leider nicht hin.
Hier der Code:

Private Sub EMAIL_Senden(Empfänger As String, Betreff As String)
Dim MyOutApp As Object, MyMessage As Object
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = Empfänger '"Hier kommt die Adresse rein"
.CC = "Copy"
.Bcc = "Blind-Copy"
.Subject = Betreff '"Text für Betreffzeile"
'.Body = ""
.Importance = 2 '
.Display
'.Attachments.Add sPath
'.Send 'Hier wird die Mail gesendet
End With
'Mail.Display
Set MyOutApp = Nothing
Set MyMessage = Nothing
' Dann die Zwischenablage einfügen
Application.SendKeys ("^v") ' Strg-V Anweisung
End Sub
Gruß DirkR

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Email mit zwei vorangestellten Leerzeilen
07.12.2014 19:56:41
Tino
Hallo,
Versuch mal so.
.Body = Chr(13)  & Chr(13)
Gruß Tino

AW: Email mit zwei vorangestellten Leerzeilen
07.12.2014 20:31:37
DirkR
Hallo Tino,
habe ich schon probiert. Allerdings sind dann die beiden Leerzeilen nach dem eingefügten Bereich!?!
Gruß DirkR

AW: Email mit zwei vorangestellten Leerzeilen
07.12.2014 20:53:46
Tino
Hallo,
versuch es mal so (nicht getestet), sonst weis ich jetzt auch nicht!
'...
Application.SendKeys ("^v") ' Strg-V Anweisung
DoEvents
MyMessage.Body = Chr(13) & Chr(13) & MyMessage.Body
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub
Gruß Tino

AW: Email mit zwei vorangestellten Leerzeilen
07.12.2014 21:05:28
DirkR
Hallo Toni,
klappt leider auch nicht!
Gruß DirkR

Anzeige
was liegt in der Zwischenablage? oT (Tino n. Toni)
07.12.2014 21:22:10
Tino

AW: was liegt in der Zwischenablage? oT (Tino n. Toni)
07.12.2014 21:27:25
DirkR
Hallo Tino,
ich kopiere einen Tabellenbereich.
hier der Code:
Private Sub CommandButton5_Click()
'#### Kunde EMAIL
Dim Empfänger As String, Betreff As String
Dim Zeile As Long, Spalte As Long, I As Long, J As Long
UserForm1.Show
Select Case (Me.Tag)
Case (1)
'Blanko
'With Sheets("Blankomail Interessent")
'  .Range("A1:B" & LastRow(Sheets("Blankomail Interessent"))).Copy
'End With
Case (2)
'Erstmail
With Sheets("Erstmail Interessent")
.Range("A9").Value = IIf(TextBox5.Value = "Herr", "Sehr geehrter Herr ", "Sehr  _
geehrte Frau ") & TextBox6.Value & ","
'Ihr persönlicher Ansprechpartner/ Fachberater
For I = 1 To LastRow(Sheets("Erstmail Interessent"))
For J = 1 To LastCol(Sheets("Erstmail Interessent"))
If Left(Cells(I, J).Value, 32) = "Ihr persönlicher Ansprechpartner" Then
Zeile = I: Spalte = J
End If
Next J
Next I
.Cells(Zeile, Spalte + 1).Value = TextBox21.Value                             'Name,  _
Vorname
.Cells(Zeile + 1, Spalte + 1).Value = ""                                      ' _
Bautechniker???
.Cells(Zeile + 2, Spalte + 1).Value = TextBox22.Value                         'Straße  _
Haus-Nr.
.Cells(Zeile + 3, Spalte + 1).Value = TextBox23.Value & " " & TextBox24.Value ' _
PLZ_Ort
.Cells(Zeile + 4, Spalte + 1).Value = "" '"Tel. Festnetz: "                   'Tel.  _
Festnetz
.Cells(Zeile + 5, Spalte + 1).Value = "Tel. Mobil: " & TextBox25.Value        'Tel.  _
Mobil
.Cells(Zeile + 6, Spalte + 1).Value = "Fax: " & TextBox26.Value               'Fax
.Cells(Zeile + 7, Spalte + 1).Value = ""                                      ' _
Leerzeile
.Cells(Zeile + 8, Spalte + 1).Value = "E-Mail: " & TextBox27.Value            'E-Mail- _
Adresse
.Range("A1:B" & LastRow(Sheets("Erstmail Interessent"))).Copy
End With
Case (3)
'Zweitmail
With Sheets("Zweitmail Interessent")
.Range("A9").Value = IIf(TextBox5.Value = "Herr", "Sehr geehrter Herr ", "Sehr  _
geehrte Frau ") & TextBox6.Value & ","
'Ihr persönlicher Ansprechpartner/ Fachberater
For I = 1 To LastRow(Sheets("Zweitmail Interessent"))
For J = 1 To LastCol(Sheets("Zweitmail Interessent"))
If Left(Cells(I, J).Value, 32) = "Ihr persönlicher Ansprechpartner" Then
Zeile = I: Spalte = J
End If
Next J
Next I
.Cells(Zeile, Spalte + 1).Value = TextBox21.Value                             'Name,  _
Vorname
.Cells(Zeile + 1, Spalte + 1).Value = ""                                      ' _
Bautechniker???
.Cells(Zeile + 2, Spalte + 1).Value = TextBox22.Value                         'Straße  _
Haus-Nr.
.Cells(Zeile + 3, Spalte + 1).Value = TextBox23.Value & " " & TextBox24.Value ' _
PLZ_Ort
.Cells(Zeile + 4, Spalte + 1).Value = "" '"Tel. Festnetz: "                   'Tel.  _
Festnetz
.Cells(Zeile + 5, Spalte + 1).Value = "Tel. Mobil: " & TextBox25.Value        'Tel.  _
Mobil
.Cells(Zeile + 6, Spalte + 1).Value = "Fax: " & TextBox26.Value               'Fax
.Cells(Zeile + 7, Spalte + 1).Value = ""                                      ' _
Leerzeile
.Cells(Zeile + 8, Spalte + 1).Value = "E-Mail: " & TextBox27.Value            'E-Mail- _
Adresse
.Range("A1:B" & LastRow(Sheets("Zweitmail Interessent"))).Copy
End With
End Select
Empfänger = TextBox15.Value
Betreff = "Ihre Anfrage"
Call EMAIL_Senden(Empfänger, Betreff)
TextBox15.SetFocus
End Sub
Gruß DirkR

Anzeige
keine Ahnung, ...
07.12.2014 23:08:09
Tino
Hallo,
evtl. den Range in HTML Text wandeln
mit ActiveWorkbook.PublishObjects ... (weiß jetzt nicht genau)
in ein File schreiben und auslesen und die zwei Zeilenumbrüche davor setzen.
und den Body als htmlbody schreiben.
Gruß Tino

hier ein Beispiel
08.12.2014 16:58:38
Tino
Hallo,
der aufruf erfolgt bei dir so ohne kopieren.
Call EMAIL_Senden(Empfänger, Betreff,.Range("A1:B" & LastRow(Sheets("Zweitmail Interessent"))))

Private Sub EMAIL_Senden(Empfänger As String, Betreff As String, rngBody As Range)
Dim MyOutApp As Object, MyMessage As Object
Dim sPath$, sHTMLBody$, sInhalt$
Dim F%

sPath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
sPath = sPath & "tmpHTMLFile.html"

ThisWorkbook.PublishObjects.Add( _
    xlSourceRange, _
    sPath, _
    rngBody.Parent.Name, _
    rngBody.Address, _
    xlHtmlStatic).Publish (True)


F = FreeFile
Open sPath For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close

Kill sPath

sInhalt = Replace(sInhalt, "align=center", "align=left")
sInhalt = "<br>" & "<br>" & sInhalt

Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)

With MyMessage
  .To = Empfänger '"Hier kommt die Adresse rein" 
  .CC = "Copy"
  .Bcc = "Blind-Copy"
  .Subject = Betreff '"Text für Betreffzeile" 
  .htmlBody = sInhalt
  .Importance = 2 ' 
  .Display
  '.Attachments.Add sPath 
  '.Send 'Hier wird die Mail gesendet 
End With
Set MyOutApp = Nothing
Set MyMessage = Nothing

End Sub
Gruß Tino

Anzeige
AW: hier ein Beispiel
10.12.2014 21:24:12
DirkR
Hallo Tino,
konnte leider erst heute deinen Code einbauen und testen.
Leider bekomme ich folgende Fehlermeldung:
Fehler beim Kompilieren:
Unzulässige oder nicht ausreichend definierter Verweis
Es wird ".Range" im Code "Call EMAIL_Senden(Empfänger, Betreff, .Range("A1:B" & LastRow(Sheets("Zweitmail Interessent"))))" markiert?!?!
Gruß DirkR

AW: hier ein Beispiel
10.12.2014 21:47:49
Tino
Hallo,
als Range musst du den Bereich übergeben den du zuvor kopiert hast!
Gruß Tino

AW: siehe hier Beispiel Datei ...
11.12.2014 14:37:30
DirkR
Hallo Tino,
habe es nun hinbekommen. Läuft so schon mal super, vielen Dank dafür.
Allerdings habe ich ein Problem. Ich habe auf dem Sheet, das als Vorlage für die Email dient, eine Grafik. Diese wird leider nicht eingefügt, bzw. ein Frame ist sichtbar mit dem Text: "Das Bild kann zur Zeit nicht angezeigt werden".
Hast du dafür noch eine Lösung.
Danke schon mal!
Gruß DirkR

keine Ahnung, sorry! oT.
11.12.2014 16:12:48
Tino

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige