Clever-Excel-Forum › Beispiele und Workshops › Tipps & Tricks v
[Word / Excel] Word und Excel als Emailanhang

Thema geschlossen 
Baumstrukturmodus
[Word / Excel] Word und Excel als Emailanhang
mumpel Offline
Spezialist für RibbonX-Programmierung
Registriert seit: 11.04.2014
Version(en): Office 365
#1
17.01.2015, 01:28 (Dieser Beitrag wurde zuletzt bearbeitet: 17.01.2015, 07:25 von WillWissen.)
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
Nützliche Helferlein für Excel und Word
Menüband und Schnellzugriffleiste programmieren
Outlook- und Email-Workshop
Thunderbird-Email mit VBA erstellen
Homepage Suchen
Top
Thema geschlossen 


Gehe zu:


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