Thema: Inhalt einer Tabelle periodisch mit Outlook versenden

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

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