creates a backup file every 4 hours according to computer system time

[Nikko]

Hello all,
I have this code where the workbook with the command "save" also created a backup file.
But wants to create a backup file (like now) where it creates in background a backup file every 4 hours according to computer system time. Instead of using the "save" command.
Can someone help me and change the vba code so that it is possible ... if this is of course possible . I'm not a big VBA light, please be patient with me

Option Explicit



Private Const Pfad As String = "\\WDMYCLOUD\Team\0 Niko\PLANER\Planer 2020\Backup\"

Private Const Dname As String = "Backup"



Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim Info As VbMsgBoxResult

   

    If Not ReadOnly Then

       

        If Not Saved Then

           

            If MsgBox("Die Mappe wurde noch nicht gespeichert." & vbLf & _

                "Soll diese Mappe gespeichert werden?", vbYesNo Or vbQuestion, _

                "Schließen und Speichern?") = vbYes Then

               

                With Application

                    .ScreenUpdating = False

                    .DisplayAlerts = False

                    .EnableEvents = False

                End With

                        Save

                                Sheets.Copy

                With ActiveWorkbook

                    .SaveAs Filename:=Pfad & Dname & Format$(Now, "yyyy-mm-dd - hh-mm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled

                    .Close

                End With

                With Application

                    .ScreenUpdating = True

                    .DisplayAlerts = True

                    .EnableEvents = True

                End With

            Else

                Saved = True

               

            End If

        End If

    End If

End Sub



Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

   

    If Not ReadOnly And Not SaveAsUI Then

       

        With Application

            .ScreenUpdating = False

            .DisplayAlerts = False

        End With

       

        Sheets.Copy

        With ActiveWorkbook

            .SaveAs Filename:=Pfad & Dname & Format$(Now, "yyyy-mm-dd - hh-mm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled

            .Close

        End With

       

        With Application

            .ScreenUpdating = True

            .DisplayAlerts = True

        End With

    End If

End Sub

 

[Nikko]

If I included this command in the end, could it work?

.OnTime Now + TimeValue("04:00:00"), "AutoSave"

Can use any help

 

[ogalbnafets]

Hello!
According to the documentation, I think you would need to seperate the backup procedure in a seperate Sub and run it from another point with Application.OnTime:
learn.microsoft.com