Thema Datum  Von Nutzer Rating
Antwort
05.02.2024 19:35:46 Peter
NotSolved
06.02.2024 03:17:03 Gast76988
NotSolved
06.02.2024 08:00:44 Peter
NotSolved
Blau Excel nach Outlook
07.02.2024 09:23:43 volti
NotSolved
07.02.2024 13:33:52 Alberfish
NotSolved

Ansicht des Beitrags:
Von:
volti
Datum:
07.02.2024 09:23:43
Views:
147
Rating: Antwort:
  Ja
Thema:
Excel nach Outlook

Hallo,

teste mal, ob der Fehler bei meiner Range2HTML auch auftritt, ansonsten ist es schwer, ohne die Datei das original testen und Schlüsse daraus ziehen zu können.

Ich persönlich nehme Range2HTML eher selten, sondern kopiere den gewünschten Bereich entweder als Bereich oder als Bild über den Wordeditor ins Outlook. Es gibt darüber hinaus noch einige Methoden Bereiche oder Bilder nach Outlook zu bringen.

Siehe ausbaufähige Muster-Sub unten.

Code:

 
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
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, "<link rel=File-List href=") + 26
      If P > 26 Then
         sTmp = Mid$(Range2Html, P, InStr(P, Range2Html, "/filelist.xml") - P)
         Range2Html = Replace(Range2Html, sTmp, sTmpVz & sTmp)
      End If

  End With

  On Error Resume Next
  Kill sTmpDatei
  Kill sTmpVz & sTmp

End Function


Private Sub Mail_BereichalsBereich_Word1()
' Sendet Mail mit integriertem Bereich als Bereich mit Signatur
  Dim WSh1 As Worksheet, WSh2 As Worksheet
  Dim sMailtext As String, sBer As String, iZeile As Long

  iZeile = Selection.Row
  sBer = Selection.EntireRow.Address             ' Kopierbereich ganze Zeile
  Set WSh1 = ThisWorkbook.Sheets("Tabelle1")     ' Blatt mit Maildaten
  Set WSh2 = ThisWorkbook.Sheets("Tabelle2")     ' Datenblatt

  sMailtext = "Hier ist die kopierte Tabellenzeile:" & vbLf & vbLf

  With CreateObject("Outlook.Application").CreateItem(0)
      .Getinspector.Display                      ' Signatur holen und anzeigen
      .Subject = "Tabellenzeile kopiert"         ' Betreff
      .To = WSh1.Range("A" & iZeile).Value       ' Empfänger
      .CC = WSh1.Range("B" & iZeile).Value       ' ggf. Kopie
      .body = sMailtext & vbLf & .body

      WSh2.Range(sBer).Copy                      ' Bereich kopieren
      With .Getinspector.WordEditor.Application.Selection
          .Start = Len(sMailtext)
          .Paste                                 ' Bereich in Mail einfügen
      End With

  End With

End Sub
_________
viele Grüße
Karl-Heinz

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.02.2024 19:35:46 Peter
NotSolved
06.02.2024 03:17:03 Gast76988
NotSolved
06.02.2024 08:00:44 Peter
NotSolved
Blau Excel nach Outlook
07.02.2024 09:23:43 volti
NotSolved
07.02.2024 13:33:52 Alberfish
NotSolved