Thema: Arbeitsstunden in einem vorgegebenen Zeitraum

ClassModule: Tabelle1

Private Sub cmdStart_Click()
  Call Versenden
End Sub

ClassModule: DieseArbeitsmappe

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Call StopEmail
End Sub

StandardModule: basMain

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

Private Sub SendEmail()
   Dim wks As Worksheet
   Dim iRow As Integer
   Dim sFile As String
   Application.ScreenUpdating = False
   sFile = Range("D2").Value
   If Dir(sFile) = "" Then
      Beep
      MsgBox "Zu versendende Datei nicht gefunden!"
   Else
      Application.EnableEvents = False
      On Error GoTo ERRORHANDLER
      Workbooks.Open Filename:=sFile, updatelinks:=False
      iRow = 1
      With ThisWorkbook.Worksheets("Tabelle1")
         Do Until IsEmpty(.Cells(iRow, 1))
            ActiveWorkbook.SendMail .Cells(iRow, 1).Value, Date
            iRow = iRow + 1
         Loop
      End With
      ActiveWorkbook.Close savechanges:=False
   End If
   Call StartEmail
ERRORHANDLER:
      Application.EnableEvents = True
      Application.ScreenUpdating = True
End Sub

Sub StartEmail()
   Dim iIntervall As Integer
   iIntervall = Range("D1").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

Beiträge aus dem Excel-Forum zu den Themen UDF und DatumUndZeit