Gruppe
Extern
Problem
Wie kann ich zeitgesteuert eine bestimmte Arbeitsmappe öffnen, Daten per VBA-Code eintragen lassen, per Email versenden und wieder schließen?
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