MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 18.10.2017, 16:08   #1
TSFC
Neuer Benutzer
Neuer Benutzer
Standard VBA - Excel-Zwischenablage in Outlook-Body einfügen

Hallo liebe Experten,

ich versuche seit geraumer Zeit einen kopierten Bereich aus Excel in den Body meiner E-Mail zu kopieren. Dabei soll die Formartierung der Tabelle erhalten bleiben.

Kann mir diesbzgl. jemand weiterhelfen? Meine Recherche hat mir leider keinen Erfolg gebracht.

Mein bisheriger Code sieht wie folgt aus und funktioniert bis auf das Einfügen der Zwischenablage.

Sub xxx()

Windows("xxx").Activate
Sheets("xxx").Select

ActiveSheet.Range("$A$1:$i$1").AutoFilter Field:=1, Criteria1:="<>xxx", _
Operator:=xlAnd
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlToTop

Sheets("xxx").ShowAllData

Range("B1:I1").Select
Range(Selection, Selection.End(xlDown).Offset(1, 0)).Select
Selection.Copy


Dim strHTML As String
Dim OutApp As Object
Dim OutMail As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.getInspector
.To = "xxx"
.Subject = ("xxx")
.HTMLBody = "

" & "Hallo," & "

" & "anbei sende ich eine Tabelle." & "

" & strHTML & .HTMLBody
.display '.send 'or use .Display
End With

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Vielen Dank im Voraus!

Gruss

Thomas
TSFC ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 18.10.2017, 16:15   #2
Storax
MOF Profi
MOF Profi
Standard

Vielleicht hilft das oder das oder hier

Und das hilft vielleicht auch, besonders Step 1

__________________

This isn't a code writing service, you need to do some research and have a go at writing some of your own code.
Be careful, content may contain traces of irony.

Geändert von Storax (18.10.2017 um 16:19 Uhr).
Storax ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.10.2017, 09:28   #3
TSFC
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hi Storax,

vielen Dank für deinen schnellen Support.

Hatte diese Quellen auch schon gefunden. Aufgrund von mangelnden VBA-Kenntnissen, konnte ich dies jedoch nicht auf meine Erfordernisse übertragen.

Besteht nicht die Möglichkeit mein bisheriges Skript irgendwie zu ergänzen?

Gruss

Thomas
TSFC ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.10.2017, 11:36   #4
Storax
MOF Profi
MOF Profi
Standard

Dein bisheriges Skript kann man mit Hilfe der Links sicher ergänzen, aber versuch es doch mal selbst.
Oder suchst Du nur jemanden, der den Code (den Du wohl auch nur irgendwoher kopiert hast) anpasst, weil Du selber überhaupt keinen Plan von VBA hast (was zunächst nicht schlimm ist), dann bin ich nicht der richtige.
Vielleicht hat jmd anders Lust darauf ...

__________________

This isn't a code writing service, you need to do some research and have a go at writing some of your own code.
Be careful, content may contain traces of irony.
Storax ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.10.2017, 11:43   #5
TSFC
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hi Storax,

das ist genau der Fall. Viele Sachen versuche ich mit der Aufnahmefunktion zu lösen oder mit Hilfe von "Google-Recherche" einen Lösungsansatz zu finden. Da ich jedoch keine Ahnung von dieser Programmiersprache habe, fällt mir das anpassen sehr schwer. Deshalb ist meine letzte Hoffnung eben immer dieses Forum.

Vielleicht habe ich ja Glück und jemand hilft mir. :-(
TSFC ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.10.2017, 11:47   #6
mumpel
MOF Meister
MOF Meister
Standard

Hallo!

Zitat: von Storax Beitrag anzeigen

(...) Vielleicht hat jmd anders Lust darauf (...)

Ich mag schon deshalb nicht weil hier der Beispielcode einfach nur so in den Text geklatscht wurde (da sind die HTML-Tags umgewandelt worden).

Gruß, René
mumpel ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.10.2017, 12:15   #7
TSFC
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hi René,

was wäre denn eine bessere Möglichkeit den Beispielcode zu posten?

Gruss

Thomas
TSFC ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.10.2017, 12:35   #8
steve1da
MOF Meister
MOF Meister
Standard

Hola,

geht wohl jetzt hier weiter:

http://www.vba-forum.de/forum/View.a..._einf%C3%BCgen

Gruß,
steve1da
steve1da ist gerade online  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.10.2017, 14:29   #9
MisterBurns
MOF Profi
MOF Profi
Standard

Hallo Thomas,

bitte unterlasse Crosspostings, siehe dazu auch die Forenregeln!

Ich habe mir aus Eigeninteresse jetzt mal die Mühe gemacht und das selbst zusammengestoppelt (Du musst die Auskommentierungen der ersten 8 Zeilen noch entfernen, die habe ich nicht getestet):

Code:

Private Sub Email()

'Windows("xxx").Activate
'Sheets("xxx").Select
'
'ActiveSheet.Range("$A$1:$i$1").AutoFilter Field:=1, Criteria1:="<>xxx", _
'Operator:=xlAnd
'Rows("2:2").Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.Delete Shift:=xlToTop
'
'Sheets("xxx").ShowAllData

Dim Lz As Long
Dim rng As Range
Dim outApp As Object
Dim outMail As Object

    Lz = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range("B1:I" & Lz)
    rng.Copy

Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(0)


With outMail
.getInspector
.To = "xxx"
.Subject = ("xxx")
.HTMLBody = "Hallo," & "" & "" _
& "anbei sende ich eine Tabelle." & "" & "" _
& RangetoHTML(rng)

.Display '.send 'or use .Display
End With

Set outMail = Nothing
Set outApp = Nothing


End Sub

Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
LG
Berni


PS: Du musst zusätzlich unbedingt folgendes machen:
http://microsoft.public.de.excel.nar...rary-einbinden

Sonst geht es nicht!

__________________

Schöne Grüße
Berni

Geändert von MisterBurns (19.10.2017 um 14:45 Uhr).
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.10.2017, 15:48   #10
TSFC
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hi Berni,

vielen lieben Dank.

Sorry, das war mir nicht bewusst, dass dies nicht erlaubt ist.
Werde ich künftig unterlassen.

Soweit passt es.

Es besteht nur noch ein Problem: Umlaute und das €-Zeichen werden in Hieroglyphen dargestellt.

Hast du hierfür vielleicht noch eine Idee?

Gruss

Thomas
TSFC ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.10.2017, 17:15   #11
mumpel
MOF Meister
MOF Meister
Standard

Umlaute kannst Du vorher umwandeln.

Sub Test()
Dim strBeispiel As String
Dim olApp       As Object
Dim strOldBody  As String


strBeispiel = "ÄÖÜäöü߀"
strBeispiel = Replace(strBeispiel, "Ä", "&#196;")
strBeispiel = Replace(strBeispiel, "Ö", "&#214;")
strBeispiel = Replace(strBeispiel, "Ü", "&#220;")
strBeispiel = Replace(strBeispiel, "ä", "&#228;")
strBeispiel = Replace(strBeispiel, "ö", "&#246;")
strBeispiel = Replace(strBeispiel, "ü", "&#252;")
strBeispiel = Replace(strBeispiel, "ß", "&szlig;")
strBeispiel = Replace(strBeispiel, "€", "&euro;")

Set olApp = CreateObject("Outlook.Application")
    With olApp.CreateItem(0)
              .GetInspector.Display
              strOldBody = .HTMLBody
              .To = "test@test.de"
              .Subject = "Test"
              .HTMLBody = strBeispiel & "<br><br>" & strOldBody
    End With
End Sub


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0



Aber normalerweise sollten Sonderzeichen nicht verstümmelt werden. Könnte am Zeichensatz liegen. Setze mal den Internetexplorer zurück. IE starten, Extras=>Internetoptionen, Register "Erweitert". Klicken auf "Erweiterte Einstellungen wiederherstellen" und auf "Zurücksetzen".

Geändert von mumpel (19.10.2017 um 17:18 Uhr).
mumpel ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 20.10.2017, 07:27   #12
MisterBurns
MOF Profi
MOF Profi
Standard

Also bei mir werden alle Zeichen korrekt an Outlook übergeben.

Zum Tipp von Mumpel siehe auch diesen Link
Ansonsten wäre noch die Frage, welche Outlookversion du benutzt. Und hat die Nachricht selbst auch das Format HTML? Oder ist hier evtl. Text eingestellt?
Angehängte Grafiken
Dateityp: png Unbenannt.PNG (5,3 KB, 8x aufgerufen)

__________________

Schöne Grüße
Berni

Geändert von MisterBurns (20.10.2017 um 07:32 Uhr).
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 20.10.2017, 13:00   #13
TSFC
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo Zusammen,

super. Vielen Dank für Eure Hilfe.

Gruss

Thomas
TSFC ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 15:45 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.