Das Clever-Excel-Forum.de - Treffen
... 14.-16. September 2018 im Allgäu ...

[Word / Excel] Word und Excel als Emailanhang
#1
Versenden mit Outlook

Sie möchten einen Text eines Worddokuments oder einen markierten Excel-Zellbereich direkt in den Mailbody einfügen? Dann können Sie die folgenden Makros nutzen.

Für Word: In ein Standardmodul

Sub MailBodyDialog()
Dim Source As Document
Dim olapp As Object
On Error Resume Next
If MsgBox("Soll der gesamte Text markiert werden?", vbYesNo + vbQuestion, "Frage") = vbYes Then Selection.WholeStory
Selection.Copy
Documents.Add
Selection.PasteAndFormat (wdPasteDefault)
strfilename = Environ$("TEMP") & "/" & Format(Now, "dd-mm-yyyy_hh-mm-ss") & ".htm"
ActiveDocument.SaveAs strfilename, wdFormatHTML
texttohtml = CreateObject("Scripting.FileSystemObject").GetFile(strfilename).OpenAsTextStream(1, -2).ReadAll
ActiveDocument.Close
Kill strfilename
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.to = "mail@server.de" 'Empfänger
'.cc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Kopie an
'.bcc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Blindkopie an
'.ReadReceiptRequested = True ' optional Lesbestätigung anfordern
.HtmlBody = texttohtml
.Subject = "Text" 'Betreff optional
.Display
End With
Set olapp = Nothing
End Sub




VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 15

Für Excel: In ein Standardmodul (Das Makro "MailBodyDialog" führt die Aktion aus)

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"
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 GoTo 0
End With
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
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=")
TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set Fso = Nothing
Set TempWB = Nothing
End Function



Sub MailBodyDialog()
Dim rng As Range
Dim olapp As Object
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
Set rng = Selection
.HtmlBody = RangetoHTML(rng)
.to = "mail@server.de" 'Empfänger
.cc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Kopie an
'.bcc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Blindkopie an
'.ReadReceiptRequested = True ' optional Lesbestätigung anfordern
.Display
End With
Set rng = Nothing
Set olapp = Nothing
End Sub




VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 15


Sie möchten das aktive Worddokument als Emailanhang senden?

In ein Standardmodul

Sub AktivesDokumentAlsAnhang()
Dim aws As String
Dim olapp As Object
ActiveDocument.Save
aws = ActiveDocument.FullName
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.To = "empfänger@server.de"
'.cc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Kopie an
'.bcc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Blindkopie an
.Subject = "Text" ' Betreff optional
.HtmlBody = "Text" ' Body optional
'.ReadReceiptRequested = True 'optional Lesebestätigung anfordern
.Attachments.Add aws
.Display
'SendKeys "%s", True ' optional Mail sofort senden
End With
Set olapp = Nothing
End Sub




VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 15


Sie möchten die aktive Arbeitsmappe als Emailanhang senden?

In ein Standardmodul

Sub AktiveArbeitsmappeAlsAnhang()
Application.DisplayAlerts = False
Dim aws As String
Dim olapp As Object
ActiveWorkbook.Save
aws = ActiveWorkbook.FullName
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.To = "empfänger@server.de"
'.cc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Kopie an
'.bcc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Blindkopie an
.Subject = "Text" ' Betreff optional
.HtmlBody = "Text" ' Body optional
'.ReadReceiptRequested = True 'optional Lesebestätigung anfordern
.Attachments.Add aws
.Display
'SendKeys "%s", True ' optional Mail sofort senden
End With
Set olapp = Nothing
Application.DisplayAlerts = True
End Sub




VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 15


Sie möchten die aktive Tabelle als Emailanhang senden?

In ein Standardmodul

Sub AktiveTabelleAlsAnhang()
Application.DisplayAlerts = False
Dim aws As String
Dim olapp As Object
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.Save
aws = ActiveWorkbook.FullName
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.to = "mail@server.de" 'Empfänger
'.cc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Kopie an
'.bcc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Blindkopie an
'.ReadReceiptRequested = True ' optional Lesbestätigung anfordern
.htmlbody = "Text" 'Optional Body
.Subject = "Text" 'Betreff optional
.ReadReceiptRequested = True 'optional Lesebestätigung anfordern
.Attachments.Add aws
.display
'SendKeys "%s", True ' optional Mail sofort senden
End With
Set olapp = Nothing
Application.DisplayAlerts = True
End Sub




VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 15



Versenden mit Lotus-Mail
(Code ist ungetestet, da das Testequipment fehlt)

Arbeitsmappe als Email versenden

Sub SendNotesMail()
Application.DisplayAlerts = False
Dim Maildb As Object
Dim MailDbName As String
Dim MailDoc As Object
Dim session As Object
Dim Recipient As String
Dim e As String
Dim f As String
Dim EmbedObj As Object
Dim AttachME As Object
ActiveWorkbook.Save
aws = ActiveWorkbook.FullName
Set session = CreateObject("Notes.NotesSession")
Set Maildb = session.CURRENTDATABASE
'On Error Resume Next
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
Recipient = "meine.email@adresse.ch"
MailDoc.sendto = Recipient
MailDoc.CopyTo = ""
MailDoc.Subject = "Mail aus Excel"
MailDoc.SAVEMESSAGEONSEND = True
'Pfad zur zu versendenden Datei
Set AttachME = MailDoc.CREATERICHTEXTITEM(ActiveWorkbook.Path & aws)
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", ActiveWorkbook.Path & aws)
MailDoc.PostedDate = Now()
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj = Nothing
Application.DisplayAlerts = True
'MsgBox "Mail versandt!" 'optional
End Sub




VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 15


Aktive Tabelle als Email versenden

Sub SendNotesMail()
Application.DisplayAlerts = False
Dim Maildb As Object
Dim MailDbName As String
Dim MailDoc As Object
Dim session As Object
Dim Recipient As String
Dim e As String
Dim f As String
Dim EmbedObj As Object
Dim AttachME As Object
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.Save
aws = ActiveWorkbook.FullName
Set session = CreateObject("Notes.NotesSession")
Set Maildb = session.CURRENTDATABASE
'On Error Resume Next
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
Recipient = "meine.email@adresse.ch"
MailDoc.sendto = Recipient
MailDoc.CopyTo = ""
MailDoc.Subject = "Mail aus Excel"
MailDoc.SAVEMESSAGEONSEND = True
'Pfad zur zu versendenden Datei
Set AttachME = MailDoc.CREATERICHTEXTITEM(ActiveWorkbook.Path & aws)
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", ActiveWorkbook.Path & aws)
MailDoc.PostedDate = Now()
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj = Nothing
Application.DisplayAlerts = True
'MsgBox "Mail versandt!" 'optional
End Sub




VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 15


Aktives Dokument als Email versenden

Sub SendNotesMail()
Application.DisplayAlerts = False
Dim Maildb As Object
Dim MailDbName As String
Dim MailDoc As Object
Dim session As Object
Dim Recipient As String
Dim e As String
Dim f As String
Dim EmbedObj As Object
Dim AttachME As Object
ActiveDocument.Save
aws = ActiveDocument.FullName
Set session = CreateObject("Notes.NotesSession")
Set Maildb = session.CURRENTDATABASE
'On Error Resume Next
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
Recipient = "meine.email@adresse.ch"
MailDoc.sendto = Recipient
MailDoc.CopyTo = ""
MailDoc.Subject = "Mail aus Excel"
MailDoc.SAVEMESSAGEONSEND = True
'Pfad zur zu versendenden Datei
Set AttachME = MailDoc.CREATERICHTEXTITEM(ActiveDocument.Path & aws)
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", ActiveDocument.Path & aws)
MailDoc.PostedDate = Now()
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj = Nothing
Application.DisplayAlerts = True
'MsgBox "Mail versandt!" 'optional
End Sub




VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 15
to top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste