title image


Smiley Re: Mappeninhalt per Email versenden - nicht als Anhang
Hallo Andi,



hier mal ein Beispiel für Outlook. Den Code sollte man aber noch etwas aufräumen. Übernommen wird der markierte Bereich incl. Formatierungen.





Private strTempFile As String 'Name der temporären html-Datei

Private strPathFile As String 'Pfad und Name der temporären html-Datei

Private strTable As String 'Name des Tabellenblatts

 

Private strRecipient As String

Private strCarbonCopy As String

Private strBlindCarbonCopy As String

 

Private strSubject As String

Private strHtml As String

 

Private strRange As String 'Der zu übertragende Rangebereich

Private objpoTemp As PublishObject

  

Private Sub CreateTempHtml()

  strTempFile = "tempfile.htm"

  strPathFile = ActiveWorkbook.Path & "\" & strTempFile

  strTable = ActiveWorkbook.ActiveSheet.Name

  

  'Der zu übertragende Rangebereich; Mehrfachselektion ist nicht zulässig;

  'Falls doch Mehrfachselektion vorliegt, wird der erste Bereich genommen

  strRange = Selection.Areas(1).Address(0, 0)

  'Erzeugen des PublishObject-Objektes zur Erzeugen der temporären html-Datei

  Set objpoTemp = ActiveWorkbook.PublishObjects.Add(xlSourceRange, strPathFile, strTable, strRange, xlHtmlStatic, "", "")

  'Erzeugen der temporären html-Datei

  objpoTemp.Publish

End Sub

 

Sub ReadTempHtml()

  Dim strLine As String

  

  strLine = ""

  strHtml = ""

  

  Open strPathFile For Input As #1    ' Datei öffnen.

  

  Do While Not EOF(1)    ' Schleife bis Dateiende.

    Line Input #1, strLine    ' Zeile in Variable einlesen.

    strHtml = strHtml & strLine

  Loop

  

  Close #1

End Sub

 

Sub SetEMailOptions()

 

End Sub

 

'CreateMail("mail@lernfundus.de","Betreff")

'Function CreateMail(pRecipient As String, Optional pSubject As String) As Object

Private Sub SendEMail()

  Dim olApp As Object

  Dim miMailItem As Object

 

  Set olApp = CreateObject("Outlook.Application")

  Set miMailItem = olApp.CreateItem(0)

 

  miMailItem.To = strRecipient

  miMailItem.CC = strCarbonCopy

  miMailItem.BCC = strBlindCarbonCopy

  miMailItem.Subject = strSubject

  miMailItem.HTMLBody = strHtml

 

  'CreateMail = miMailItem

 

  'Mail anzeigen

  miMailItem.Display

 

  ' mit dem folgenden Befehl kann direkt gesendet werden:

  'Mail.send 'disabled because of testing

 

End Sub



Private Sub InitOperations(pRecipient As String, Optional pCarbonCopy As String, Optional pBlindCarbonCopy As String, Optional pSubject As String)

  strRecipient = pRecipient

  strCarbonCopy = pCarbonCopy

  strBlindCarbonCopy = pBlindCarbonCopy

  strSubject = pSubject

End Sub

 

Private Sub ClosingOperations()

  objpoTemp.Delete

  Kill strPathFile 'Löschen der temporären Datei

End Sub

 

Sub v1()

  StartOperations "mail@lernfundus.de", "", "", "Betreff"

End Sub

 

Public Sub StartOperations(pRecipient As String, Optional pCarbonCopy As String, Optional pBlindCarbonCopy As String, Optional pSubject As String)

  InitOperations pRecipient, pCarbonCopy, pBlindCarbonCopy, pSubject

  CreateTempHtml

  ReadTempHtml

  SendEMail

  ClosingOperations

End Sub Code eingefügt mit Syntaxhighlighter 1.16





Gruß Uwe

Gruß Uwe

amolip.de



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: