Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Inhalt einer Tabelle periodisch mit Outlook versenden

Gruppe

Email

Problem

Wie kann ich eine Tabelle automatisch alle 30 Minuten an einen bestimmten Empfänger versenden? Der Versand soll über Outlook durchgeführt werden.

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

StandardModule: basMain

Public Const gsMacro As String = "SendEmail"
Public gdNextTime As Double

Sub StartEmail()
   Dim iIntervall As Integer
   iIntervall = Range("B2").Value
   gdNextTime = Now + TimeSerial(0, 0, iIntervall)
   Application.OnTime earliesttime:=gdNextTime, _
      procedure:=gsMacro, schedule:=True
End Sub

Sub StopEmail()
   On Error Resume Next
   Application.OnTime earliesttime:=gdNextTime, _
      procedure:=gsMacro, schedule:=False
End Sub

Private Sub SendEMail()
   Dim oOL As Object
   Dim oOLMsg As Object
   Dim oOLRecip As Object
   Dim oOLAttach As Object
   Dim iRow As Integer, iCol As Integer
   Dim sTxt As String
   iRow = 1
   iCol = 1
   With Worksheets("Tabelle2")
      Do Until IsEmpty(.Cells(iRow, iCol))
         Do Until IsEmpty(.Cells(iRow, iCol))
            sTxt = sTxt & .Cells(iRow, iCol) & " "
            iCol = iCol + 1
         Loop
         sTxt = WorksheetFunction.Trim(sTxt) & vbCrLf
         iCol = 1
         iRow = iRow + 1
      Loop
   End With
   Set oOL = CreateObject("Outlook.Application")
   Set oOLMsg = oOL.CreateItem(0)
   With oOLMsg
      Set oOLRecip = .Recipients.Add("hans@herber.de")
      .Subject = Format(Date, "dd.mm.yy") & " - " & Format(Time, "hh:mm:ss")
      .Body = sTxt
      .Importance = 1
      For Each oOLRecip In .Recipients
         oOLRecip.Resolve
      Next
      .Send
   End With
   Set oOL = Nothing
   Call StartEmail
End Sub