Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 17:40:39
16.10.2025 17:25:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Datenbereich in Outlook email

Datenbereich in Outlook email
10.08.2020 11:35:31
Alex
Hallo ich benutze einen VBA Code um Daten in Outlook zu kopieren,
meine Frage dazu kann man den Code auch so schreiben dass er sich auf den Bereich des gesetzten Filters bezieht ? Aktuell lese ich A2:U40 aus.
Code:
.Subject = "Titel- " & Format(Date, "dd.mm.yyyy") ' Mein Betreff 19.03.2020
.GetInspector
.htmlbody = Replace(sMailText, vbLf, "
") _
& Range2Html(ThisWorkbook.Sheets("Sheet2").Range("A2:U40")) & .htmlbody
.display
End With
End Sub
Vielen Dank
Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datenbereich in Outlook email
10.08.2020 11:43:26
peterk
Hallo
Ungetestet:
Range2Html(ThisWorkbook.Sheets("Sheet2").Range("A2:U40").SpecialCells(xlCellTypeVisible))
AW: Datenbereich in Outlook email
10.08.2020 11:49:19
Alex
Irgendwas passt ihm nicht, ich habe die Stelle mit dicker Schrifft markiert
' .Bcc = ""
.Subject = "Titel- " & Format(Date, "dd.mm.yyyy") ' Mein Betreff 19.03.2020
.GetInspector
.htmlbody = Replace(sMailText, vbLf, "
") _
& Range2Html(ThisWorkbook.Sheets("Sheet2").Range("A2:U2500").SpecialCells(xlCellTypeVisible))
.display
End With
End Sub
Private Function Range2Html(oBereich As Range) As String
'Gibt den angegebenen Bereich als HTML zur?ck, incl.Bilder
Dim sTmpDatei As String, sTmp As String, sTmpVz As String
Dim iff As Integer, P As Long
'Bereich in Datei exportieren
With oBereich
sTmpVz = Environ$("temp") & "\"
sTmpDatei = sTmpVz & Format(Now, "ddmmyy" & Int(Timer) * 10) & ".htm"
.Parent.Parent.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=sTmpDatei, Sheet:=.Parent.Name, _
Source:=.Address, _
HtmlType:=xlHtmlStatic).Publish Create:=True
iff = FreeFile
Open sTmpDatei For Input As iff
Range2Html = Replace(Input(LOF(iff), iff), "align=center x:publishsource=", _
"align=left x:publishsource=")
Close iff
'Feststellen, ob auch Bilder im Bereich sind
P = InStr(1, Range2Html, "

Anzeige
AW: Datenbereich in Outlook email
10.08.2020 12:36:40
peterk
Hallo
SpecialCells funktioniert leider wirklich nicht, versuch folgendes:

Dim lastCell As String
lastCell = ThisWorkbook.Sheets("Sheet2").Range("A2:U2500").SpecialCells(xlCellTypeLastCell). _
Address
& Range2Html(ThisWorkbook.Sheets("Sheet2").Range("A2:" & lastCell)

Anzeige
AW: Datenbereich in Outlook email
10.08.2020 13:13:07
Alex
Hmm erstmal Danke für die Tipps, ich denke ich löse dass nun das ich die werte zu dem Datum in einem extra Sheet anzeigen lasse und diese dann mit dem alten Code ins Outlook übertrage.
Nochmal Danke Gruss
AW: Datenbereich in Outlook email
10.08.2020 12:50:07
volti
Hallo Alex,
man kann der Funktion Range2HTML nicht einfach einen modifizierten Bereich übergeben, das führt zwangsläufig zum gezeigten Fehler.
Leider weiß ich auch sonst nicht, wie man hier gefilterte Zeilen berücksichtigen kann.
Alternativ könntest Du mit dem Word-Editor arbeiten. Da kann man auch ausgeblendete Zeilen unberücksichtigt lassen. Hier ein Beispiel, nach dem Du Deinen code umbauen könntest.
Falls Du Probeleme haben solltest, zeige hier mal Deinen gesamten code.

 
[+][-]
Sub Mail_BereichalsBild_Word2()
'Sendet Mail mit integriertem Bereich als Bereich mit Signatur
'Das Bild wird über das Kürzel ~ im Text platziert
 Dim WSh As Worksheet, WkS As Worksheet
 Dim sMailtext As String, sBild As String, sSignatur As String
 Dim sBer As String, iEinf As Integer
 
 sBer = "A3:G23"                            'Kopierbereich
 Set WSh = ThisWorkbook.Sheets("Tabelle1")  'Blatt mit Maildaten
 Set WkS = ThisWorkbook.Sheets("Tabelle2")  'Datenblatt
 On Error Resume Next
 
 Do
  WkS.Range(sBer).Copy                      'Bereich kopieren
   If Err.Number = 0 Then Exit Do
   Err.Clear
 Loop
 
 With CreateObject("Outlook.Application").CreateItem(0)
  .BodyFormat = 2                           '2=HTML-Format, 3=Richtext
  .Subject = WSh.Range("A2").Value          'Betreff
  .To = WSh.Range("A3").Value               'Empfänger
  .Cc = WSh.Range("A4").Value               'Kopie
   sMailtext = WSh.Range("A5").Value & ""
   sMailtext = Replace(sMailtext, "", vbLf) 'Umbrüche einfügen
  .GetInspector:  sSignatur = .htmlbody     'Signatur holen
  .htmlbody = Replace(sMailtext, vbLf, "<br>") & sSignatur
  .display
  iEinf = InStr(sMailtext, "~")
  If iEinf = 0 Then iEinf = Len(sMailtext)  'Grafik Einfügestelle
  
  With .GetInspector.WordEditor.Application.Selection
       .Start = iEinf: .End = iEinf
       .Paste                               'Grafik in Mail einfügen
  End With
 
 End With
End Sub
 

viele Grüße aus Freigericht
Karl-Heinz

Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige