Gruppe
Datei
Problem
Wie kann ich eine Arbeitsmappe im Minutenrythmus als ExcelArbeitsmappe und als *.bak-Datei speichern?
StandardModule: basMain
Sub SpeichernMinuetlich()
Dim NextTime As Date
Dim sPathB As String, sPathW As String, sPath As String
Application.DisplayAlerts = False
sPath = Range("B1").Value
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
sPathW = sPath & Format(Date, "yymmdd") & ".xls"
sPathB = sPath & Format(Now, "yymmddhhmm") & ".bak"
ActiveWorkbook.SaveAs sPathB
ActiveWorkbook.SaveAs sPathW
Range("B2").Value = Now + TimeValue("00:01:00")
Application.OnTime CDate(Range("B2").Value), "SpeichernMinuetlich"
Application.DisplayAlerts = True
End Sub
Sub StopSpeichern()
If IsEmpty(Range("B2")) Then Exit Sub
Application.OnTime _
earliesttime:=CDate(Range("B2").Value), _
procedure:="SpeichernMinuetlich", _
schedule:=False
Range("B2").ClearContents
End Sub