Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Ausgewählten Bereich als interaktive Tabelle versenden

Gruppe

Outlook

Problem

Der ausgewählte Bereich der Tabelle soll als interaktive Tabelle per Outlook versandt werden.

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: Modul1

Sub Sel2Mail()
    Dim ol As Object
    Dim oMail As Object
    Dim oFs As Object
    Dim oFile As Object
    Dim oTxtStrm As Object
    Dim sSubject As String, sBody As String, sRecipient As String
    Dim sPath As String
    sPath = Application.DefaultFilePath & "\html.htm"
    If ActiveWorkbook.PublishObjects.Count = 1 Then
        ActiveWorkbook.PublishObjects(1).Delete
    End If
    ActiveWorkbook.PublishObjects.Add _
      SourceType:=xlSourceRange, _
      Filename:=sPath, _
      Sheet:=ActiveSheet.Name, _
      Source:=Selection.Address, _
      HtmlType:=xlHtmlCalc
   ActiveWorkbook.PublishObjects(1).Publish create:=True
   Set oFs = CreateObject("Scripting.FileSystemObject")
   Set oFile = oFs.GetFile(sPath)
   Set oTxtStrm = oFile.OpenAsTextStream
   sBody = oTxtStrm.ReadAll
   Set ol = CreateObject("Outlook.Application")
   Set oMail = ol.CreateItem(0)
   oMail.Save
   oMail.To = Worksheets("Data").Range("B1").Value
   oMail.subject = Worksheets("Data").Range("B2").Value
   oMail.HTMLBody = sBody
   oMail.Importance = 1
   oMail.Sensitivity = 1
   oMail.Send
   Set ol = Nothing
   Set oMail = Nothing
   Set oFs = Nothing
   Set oFile = Nothing
   Set oTxtStrm = Nothing
   Kill sPath
End Sub