Thema: Ausgewählten Bereich als interaktive Tabelle versenden

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

Beiträge aus dem Excel-Forum zu den Themen Extern und Outlook