ClpObj.GetText(i)

Forumthread: ClpObj.GetText(i)

ClpObj.GetText(i)

30.12.2019 12:46:18

Ralf

Guten Tag,
ich habe ca. 2009 mit dem Befehl ClpObj.GetText(i) ein IMAGE eines Excelabschnitts in Outlook übertragen. Diese sub lief lange Zeit problemlos. Dann hatte ich das Projekt einige Jahre nicht mehr eingesetzt. Nun habe ich für eine andere Aufgabe auf Excel 2016 wieder diesen Befehl eingesetzt. Jetzt fügt Excel aber nur noch den Text in die Mail ein. (was ja dem Ihnhalt des Befehl eigentlich entspricht :)) Die Übertragung aller Formate habe ich dann nur noch behelfsmäßig über "Application.SendKeys ("^v")" hinbekommen. Hat jemand eine Ahnung woran das liegt und wie ich mir eleganter helfen könnte?

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: ClpObj.GetText(i)

30.12.2019 14:09:52

mumpel
AW: ClpObj.GetText(i)

30.12.2019 14:18:16

Ralf
AW: ClpObj.GetText(i)

30.12.2019 17:39:59

Oberschlumpf
AW: ClpObj.GetText(i)

30.12.2019 20:07:55

volti
AW: ClpObj.GetText(i)

31.12.2019 12:07:19

volti
AW: ClpObj.GetText(i)

02.01.2020 09:50:33

Ralf
HTML aus Zwischenablage in Mailbody

02.01.2020 09:19:16

volti
AW: HTML aus Zwischenablage in Mailbody

02.01.2020 09:52:31

Ralf

AW: ClpObj.GetText(i)

30.12.2019 14:09:52

mumpel

Hallo!
Zeig uns doch mal Deinen Code.
Gruß, René

AW: ClpObj.GetText(i)

30.12.2019 14:18:16

Ralf

Auf Wunsch von Rene hier der Code. Es muß sich aber bitte niemand die Mühe machen, mein Problem zu lösen. Ein paar Tipps würden mir sicher weiter helfen
'Outlook aufrufen
'Call Outlook_starten
' Tastenkombination: Strg+m
'
'Variablen definieren
Dim OutApp As Object, Mail As Object, i 'Verweis auf "Microsoft Forms 2.0 Object Library" aktivieren !!'sonst geht es nicht'Dataobject wird gebraucht wegen der Zwischenablage
Dim Nachricht
Dim strSubject As String, sheet As Worksheet, ClpObj As DataObject, M1 As String, M2 As String, M3 As String, M4 As String, M5 As String, M6 As String
'Dim Test As Range
' Variablen Werte zuweisen.
Set sheet = Worksheets(1)
strSubject = sheet.Range("A24").Value
M1 = sheet.Range("A13").Value
M2 = sheet.Range("A14").Value
M3 = sheet.Range("A15").Value
M4 = sheet.Range("A16").Value
'Schleife für mehrere Mails umbauen
For i = 1 To 1
Set ClpObj = New DataObject
Set OutApp = CreateObject("Outlook.Application")
Set Nachricht = OutApp.CreateItem(0)
'Excelbereich der versendet werden soll.
'Wenn kein Bereich versendet werden soll sondern
'der Bereich bereits kopiert wurde die nächsten beiden Zeilen auskommentieren
sheet.Range("A3:K30").Select
'Bereich wird in die Zwischenablage kopiert
Selection.Copy
'Nachricht wird generiert
With Nachricht
.To = M1
.CC = M2 & ";" & M3 & ";" & M4
.Subject = "Dienstfahrt " & strSubject
'Zwischenablage wird eingefügt
ClpObj.GetFromClipboard
.body = "" ' Absatzzeichen ist " & vbCrLf 'GetFromClipboard
'.Body = ClpObj.GetText(i)
'Hier wird die Mail angezeigt
.Display
'So wird die Mail gleich in den Postausgang gelegt
'.Send
End With
Set OutApp = Nothing
Set Nachricht = Nothing
'Auf Outlook warten. Ist nicht schnell genug :-))
Application.Wait (Now + TimeValue("0:00:05"))
Next
Application.SendKeys ("^v")
'End Sub Küchenmail
'Sheets("Bewohner").Select
'MsgBox "Die Küche wurde soeben per Mail benachrichtigt!"

AW: ClpObj.GetText(i)

30.12.2019 17:39:59

Oberschlumpf

Hi Ralf,
ich tippe, anstelle von .Body müsstest du .HTMLBody verwenden, da .Body nur im Textformat "anzeigt".
Wenn das als Tipp nicht reicht, zeig bitte per Upload eine Excel-Bsp-Datei mit allem Inhalt, der erforderlich ist, dein Problem zu verstehen.
Also eigtl deine jetzige Datei, nur eben mit Bsp-Werten.
Ciao
Thorsten

AW: ClpObj.GetText(i)

30.12.2019 20:07:55

volti

Hallo Ralf,
ich kann mir nicht vorstellen, dass mit dem Befehl ClpObj.GetText(i) außer dem Text auch noch die Formatierungen übernommen werden können.
Woher sollte der Befehl auch wissen, welches Format (Binär, Text, HTML) er ausgeben soll. Schon in früheren Forumsbeiträgen ist die fehlende Formatierung öfter beklagt worden.
Aber nun gut, folgende Vorschläge hätte ich dennoch für Dich, vielleicht kannst Du ja was damit anfangen:
Falls Du nur den kopierten Bereich in die Mail einfügen möchtest (ohne Kopf und Fuß, bzw. diese Angaben sind schon in Excel) könntest Du folgenden code dafür nutzen:

 Dim wdRng As Object

'....

 Selection.Copy

 Set wdRng = .GetInspector.WordEditor.Range

 wdRng.WholeStory

 wdRng.Paste

Ansonsten empfehle ich mit der Funktion RangeToHtml zu arbeiten. Basierend auf Umsetzung durch Excel selbst via Datei. Hierzu sind etliche Beiträge im Netz.
Oder Du nimmst gleich mein u.a. Beispiel. Du brauchst vorher nichts kopieren, sondern nur den Quellbereich angeben:

Sub CodesnipselBeispiel()

 Dim sMeinMailText As String

 sMeinMailText = "Hallo!"

 With CreateObject("Outlook.Application").CreateItem(0)

  .to = "Nach@web.de"

  .GetInspector

  .htmlbody = Replace(sMeinMailText, vbLf, "&LT;br&GT;") & Range2Html(Range("$A13:$C$16")) & .htmlbody

  .display

 End With

End Sub

Private Function Range2Html(oBereich As Range) As String

'Gibt den angegebenen Bereich als HTML zurück

 Dim sTMPDatei As String, oPublish As PublishObject, i As Integer

 sTMPDatei = Environ$("temp") & "\" & Format(Now, "ddmmyyhhmmss") & ".htm"

 With oBereich

  Set oPublish = ThisWorkbook.PublishObjects.Add( _

      SourceType:=xlSourceRange, _

      Filename:=sTMPDatei, _

      Sheet:=.Parent.Name, _

      Source:=.Address, _

      HtmlType:=xlHtmlStatic)

  Call oPublish.Publish(Create:=True)

 End With

 i = FreeFile

 Open sTMPDatei For Binary As i

 Range2Html = Space(LOF(1)): Get #1, , Range2Html

 Range2Html = Replace(Range2Html, "align=center x:publishsource=", "align=left x:publishsource=")

 Close i

 Kill sTMPDatei

 Set oPublish = Nothing

End Function

viele Grüße
Karl-Heinz

AW: ClpObj.GetText(i)

31.12.2019 12:07:19

volti

Hi,
hier noch leicht verbessert:

Sub CodesnipselBeispiel()

 Dim sMeinMailText As String

 sMeinMailText = "Hallo!"

 With CreateObject("Outlook.Application").CreateItem(0)

  .to = "Nach@web.de"

  .Subject = "Test"

  .GetInspector

  .htmlbody = Replace(sMeinMailText, vbLf, "&LT;br&GT;") _

            & Range2Html(Range("$A13:$C$16")) & .htmlbody

  .display

 End With

End Sub

Private Function Range2Html(oBereich As Range) As String

'Gibt den angegebenen Bereich als HTML zurück

 Dim sTMPDatei As String, oPublish As PublishObject, iff As Integer

 sTMPDatei = Environ$("temp") & "\" & Format(Now, "ddmmyyhhmmss") & ".htm"

 Set oPublish = ThisWorkbook.PublishObjects.Add( _

     SourceType:=xlSourceRange, _

     Filename:=sTMPDatei, _

     Sheet:=oBereich.Parent.Name, _

     Source:=oBereich.Address, _

     HtmlType:=xlHtmlStatic)

 Call oPublish.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

 Kill sTMPDatei

 Set oPublish = Nothing

End Function

viele Grüße
Karl-Heinz

AW: ClpObj.GetText(i)

02.01.2020 09:50:33

Ralf

Vielen, vielen Dank für die Tipps.
Ich bin sicher irgendwas wird mir helfen.

HTML aus Zwischenablage in Mailbody

02.01.2020 09:19:16

volti

Hallo Ralf,
falls das Thema im neuen Jahr noch relevant ist.
Entgegen meiner bisherigen Vorstellung sollte man mit dem Befehl ClpObj.GetText(3) auch HTML-Text aus der Zwischenablage entnehmen können, falls dort entsprechender Inhalt enthalten ist.
Ist ja im Grunde auch Text und passt daher zum Befehl.
Funktioniert aber bei mir nicht (mehr). Das DataObject macht neuerdings wohl öfter mal Schwierigkeiten.
Zur Übernahme von HTML-Text aus der Zwischenablage zum Einfügen in den eMail-Body habe ich mir jetzt einen Weg über die API erstellt. Ist ein wenig aufwendiger, funktioniert dafür aber auch:

Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _

        ByVal dwBytes As LongPtr) As LongPtr

Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr

Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr

Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr

Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long

Private Declare PtrSafe Function lstrcpy Lib "kernel32" ( _

        ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr

Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" ( _

        ByVal wFormat As Long) As Long

Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, _

        ByVal hMem As LongPtr) As LongPtr

Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long

Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long

Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32" _

        Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long

Private Function GetHTMLfromClipboard() As String

'Exceltabellenbereich via Clipboard nach HTML umwandeln

 Dim hMem As LongPtr, lpGMem As LongPtr, ClipText As String, iCF As Long

 iCF = RegisterClipboardFormat("HTML Format")

 If IsClipboardFormatAvailable(iCF) &GT; 0 Then

  OpenClipboard 0&

  hMem = GetClipboardData(iCF)

  If hMem &GT; 0 Then

   lpGMem = GlobalLock(hMem)

   ClipText = String$(CLng(GlobalSize(hMem)), " ")

   lstrcpy ClipText, lpGMem

   GlobalUnlock hMem

   GetHTMLfromClipboard = Mid$(ClipText, InStr(ClipText, "&LT;html "))

   GlobalFree hMem

  End If

  CloseClipboard

 End If

End Function

Sub CodesnipselBeispiel()

 Dim sMailText As String

 sMailText = "Hallo!&LT;br&GT;Ein Beispiel:"

 Selection.Copy

 With CreateObject("Outlook.Application").CreateItem(0)

  .To = "Nach@web.de"

  .Subject = "Test Tabelleneinfügung"

  .GetInspector

  .HTMLBody = Replace(sMailText, vbLf, "&LT;br&GT;") _

            & GetHTMLfromClipboard() & .HTMLBody

  .display

 End With

End Sub

viele Grüße
Karl-Heinz

AW: HTML aus Zwischenablage in Mailbody

02.01.2020 09:52:31

Ralf

Oh vielen Dank für die Mühe :9

Beliebteste Forumthreads (12 Monate)

Forumthread: ClpObj.GetText(i)

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

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread