Macro per backup di file excel

Question

Buongiorno,

da poco ho scoperto quanto excel può contribuire a farmi "lavorare meglio". E spero con il vs. contributo di continuare su questo percorso.

Inizio da subito.

Ho un file excel aperto 24/24 per 5 gg. a settimana ( ma alcune volte i miei collaboratori dimenticano di chiuderlo anche nel WE!!).

Vorrei che ad un orario predeterminato:

1. arrivi una avviso che il file è in chiusura
2. il file si chiuda salvandosi e creando un file di backup
3. il file si riapra avvisando dell'avvenuto backup

Francamente non saprei se quanto richiestovi  è fattibile.

Attendo vostra indicazione.

Grazie mille

by EF

Answer 1

Ciao By EF,

grazie per l'immenso aiuto

[RISOLTO]

Grazie a te per il cortese riscontro. 

Per chiudere questo thread, vorrei chiederti gentilmente di contrassegnare la mia risposta come Risposta preferita. In questo modo, tu aiuterai anche coloro che potessero cercare soluzioni ai problemi simili negli archivi della Community.

  

===

Regards,

Norman

Answer 2

Ciao By EF,

Norman:

Nota bene, però, che solo i file di backup dovrebbero essere salvati nella specifica directory perché, come scritto, il codice non distingue il tipo di file salvati nella directory. Di conseguenza, solo gli ultimi tre file saranno conservati e tutti gli altri file verranno eliminati, a prescindere dal tipo di file. Se questo potrebbe essere un problema, potrei modificare il codice per assicurare che solo i file di backup potrebbero essere eliminati.

EF:

Se la modifica di cui sopra non ti comporta tanto lavoro, sarebbe gradita per aumentarmi la flessibilità e diminuire possibili errori.

Nel modulo di codice standard, sostituisci il codice precedente con la seguente versione:

'=========>>

Option Explicit

Dim sPath As String

Public RunWhen As Double

Public Const cRunIntervalHours = 1      '\ 1 ora        '<<=== Modifica

Public Const cRunWhat = "CreaBackup"

Public Const sPercorso As String =  _

                       "**C:\Users\EDF\MyBackups**"             '<<=== Modifica

'--------->>

Public Sub CreaBackup()

    Dim arrSplit As Variant

    Dim sDateTimeStamp As String, sFilename As String

    Dim sName As String, sExt As String, sStr As String

    Const sFormat As String = "yyyy-mm-dd hh-mm"

    sStr = Application.PathSeparator

    If Right(sPercorso, 1) = sStr Then

        sPath = sPercorso

    Else

        sPath = sPercorso & sStr

    End If

    sDateTimeStamp = Format(Now, sFormat)

    With ThisWorkbook

        arrSplit = Split(.Name, ".")

        sName = arrSplit(0) & "_"

        sExt = "." & arrSplit(1)

        sFilename = sPath & sName _

                    & sDateTimeStamp & sExt

        .SaveCopyAs sFilename

    End With

    Call MsgBox( _

         Prompt:="Un file di backup " _

                 & sFilename _

                 & " è stato salvato a: " _

                 & vbNewLine _

                 & sDateTimeStamp _

                 & vbNewLine, _

         Buttons:=vbInformation, _

         Title:="BACKUP CREATO " & sDateTimeStamp)

    Call CancellaFile(sName, sExt)

    Call StartTimer

End Sub

'--------->>

Public Sub CancellaFile(aName As String, sExt As String)

    Dim oFSO As Object

    Dim oFolder As Object

    Dim oFiles As Object

    Dim oFile As Object

    Dim oOldfile As Object

    Dim iCtr As Long, jCtr As Long, kCtr As Long

    Const iMaxFileBackup As Long = 3                        '<<=== Modifica

    On Error GoTo XIT

    Set oFSO = CreateObject("Scripting.FileSystemObject")

    Set oFolder = oFSO.GetFolder(sPath)

    Set oFiles = oFolder.Files

    iCtr = iMaxFileBackup

    Do While oFiles.Count - kCtr > iCtr

        jCtr = 0

        kCtr = 0

        For Each oFile In oFiles

            With oFile

                If .Name Like aName & "????-??-?? ##-##" & sExt Then

                    jCtr = jCtr + 1

                    If oOldfile Is Nothing Then

                        Set oOldfile = oFile

                    End If

                    If oOldfile.DateLastModified > .DateLastModified Then

                        Set oOldfile = oFile

                    End If

                Else

                    kCtr = kCtr + 1

                End If

            End With

        Next oFile

        If jCtr > iMaxFileBackup Then

            oFSO.DeleteFile oOldfile, True

        End If

        Set oOldfile = Nothing

    Loop

XIT:

    Set oFile = Nothing

    Set oFiles = Nothing

    Set oFSO = Nothing

End Sub

'--------->>

Sub StartTimer()

    RunWhen = Now + TimeSerial(cRunIntervalHours, 0, 0)

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=True

End Sub

'--------->>

Public Sub StopTimer()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=False

End Sub

'<<=========

Questo codice crea un file di backup con la data e ora per il file in cui si trova il codice e assicura che solo gli ultimi tre versioni siano conservati. Altri file nella directory precisata per i file di backup non saranno toccati. Nota inoltre che il codice può essere utilizzato in più file per salvare sino a tre copie di backup per ciascuno di loro, sia in una directory comune per tutti i file di backup che una directory dedicata per ogni file. Come indicato in precedenza, il numero di copie di backup per ogni file dipende dal valore assegnato alla costante iMaxFileBackup.

===

Regards,

Norman

Answer 3

Ciao By EF,

Due approfondimenti:

1. se volessi che la copia backup fosse posizionata in una cartella specifica ( attualmente è in C:\documenti) ?
2. se volessi conservare in cartella a rotazione, solamente gli ultimi 3 salvataggi effettuati ?

Nel modulo di codice standard, sostituisci il codice precedente con la seguente versione:

'=========>>

Option Explicit

Public RunWhen As Double

Public Const cRunIntervalHours = 1      '\ 1 ora      '<<=== Modifica

Public Const cRunWhat = "CreaBackup"

Public Const sPercorso As String =  _

                       "**C:\Users\EDF\MyBackups**"            '<<=== Modifica

'--------->>

Public Sub CreaBackup()

    Dim arrSplit As Variant

    Dim sDateTimeStamp As String, sFilename As String

    sDateTimeStamp = Format(Now, "yyyy-mm-dd hh-mm")

    With ThisWorkbook

        arrSplit = Split(.Name, ".")

        sFilename = sPercorso & arrSplit(0) & "_" _

                    & sDateTimeStamp & "." & arrSplit(1)

        .SaveCopyAs sFilename

    End With

    Call MsgBox( _

         Prompt:="Un file di backup " _

                 & sFilename _

                 & " è stato salvato a: " _

                 & vbNewLine _

                 & sDateTimeStamp _

                 & vbNewLine, _

         Buttons:=vbInformation, _

         Title:="BACKUP CREATO " & sDateTimeStamp)

    Debug.Print sFilename

    Call CancellaFile

    Call StartTimer

End Sub

'--------->>

Public Sub CancellaFile()

    Dim oFSO As Object

    Dim oFolder As Object

    Dim oFiles As Object

    Dim oFile As Object

    Dim oOldfile As Object

    Const iMaxFileBackup As Long = 3                    '<<=== Modifica

    Set oFSO = CreateObject("Scripting.FileSystemObject")

    Set oFolder = oFSO.GetFolder(sPercorso)

    Set oFiles = oFolder.Files

    Do Until oFiles.Count < iMaxFileBackup + 1

        For Each oFile In oFiles

            If oOldfile Is Nothing Then

                Set oOldfile = oFile

            End If

            If oOldfile.DateLastModified > oFile.DateLastModified Then

                Set oOldfile = oFile

            End If

        Next oFile

        oFSO.DeleteFile oOldfile, True

        Set oOldfile = Nothing

    Loop

End Sub

'--------->>

Sub StartTimer()

    RunWhen = Now + TimeSerial(cRunIntervalHours, 0, 0)

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=True

End Sub

'--------->>

Public Sub StopTimer()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=False

End Sub

'<<=========

Il codice nel modulo di codice dell'oggetto T hisWorkbook(Questa_cartella_di_Lavoro) rimane inalterato.

In questo modo, i file di backup saranno salvati in una directory precisata da te, modificando il percorso della costante sPercorso) e I file di backup saranno limitati agli ultimi tre, o qualunque sia il numero stabilito dalla costante iMaxFileBackup. 

Nota bene, però, che solo i file di backup dovrebbero essere salvati nella specifica directory perché, come scritto, il codice non distingue il tipo di file salvati nella directory. Di conseguenza, solo gli ultimi tre file saranno conservati e tutti gli altri file verranno eliminati, a prescindere dal tipo di file. Se questo potrebbe essere un problema, potrei modificare il codice per assicurare che solo i file di backup potrebbero essere eliminati.

===

Regards,

Norman

Answer 4

Ciao Norman,

grazie per il benvenuto e la soluzione.

E' bastato correggere un refuso:

Public Const cRunIntervalSeconds = 1 '\ 1 ora            '<<=== Modifica

in

Public Const cRunIntervalHours = 1 '\ 1 ora            '<<=== Modifica

Due approfondimenti:

1. se volessi che la copia backup fosse posizionata in una cartella specifica ( attualmente è in C:\documenti) ?
2. se volessi conservare in cartella a rotazione, solamente gli ultimi 3 salvataggi effettuati ?

Grazie mille

by EF

Answer 5

Ciao By EF,

Benvenuto alla Community!

Ho un file excel aperto 24/24 per 5 gg. a settimana ( ma alcune volte i miei collaboratori dimenticano di chiuderlo anche nel WE!!).

Vorrei che ad un orario predeterminato:

1. arrivi una avviso che il file è in chiusura
2. il file si chiuda salvandosi e creando un file di backup
3. il file si riapra avvisando dell'avvenuto backup

Francamente non saprei se quanto richiestovi  è fattibile.

Credo che tu possa creare il file di backup del file di interesse senza che sia necessario di chiuderlo.

Quindi, prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IMper inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'=========>>

Option Explicit

Public RunWhen As Double

Public Const cRunIntervalHours = 1 '\ 1 ora            '<<=== Modifica

Public Const cRunWhat = "CreaBackup"

'--------->>

Public Sub CreaBackup()

    Dim arrSplit As Variant

    Dim sDateTimeStamp As String, sFilename As String

    sDateTimeStamp = Format(Now, "yyyy-mm-dd hh-mm")

    With ThisWorkbook

        arrSplit = Split(.Name, ".")

        sFilename = arrSplit(0) & "_" & sDateTimeStamp & arrSplit(1)

        .SaveCopyAs sFilename

    End With

    Call MsgBox( _

         Prompt:="Un file di backup " _

                 & sFilename _

                 & " è stato salvato a: " _

                 & vbNewLine _

                 & sDateTimeStamp _

                 & vbNewLine, _

         Buttons:=vbInformation, _

         Title:="BACKUP CREATO " & sDateTimeStamp)

    Call StartTimer

End Sub

'--------->>

Sub StartTimer()

    RunWhen = Now + TimeSerial(cRunIntervalHours, 0, 0)

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=True

End Sub

'--------->>

Public Sub StopTimer()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=False

End Sub

'<<========= 

• Ctrl+R per accedere alla finestra Project Explorer ('Gestione progetti')
• Fai doppio clic sul modulo ThisWorkbook (Questa_cartella_di_Lavoro) del file e incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Private Sub Workbook_Open()

    Call StartTimer

End Sub

'--------->>

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Call StopTimer

End Sub

'<<=========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensionexlsm

Con questo codice un file di backup sarà salvato a intervalli orari. Per cambiare l'intervallo, modifica la dichiarazione:

Public Const cRunIntervalHours= 1 '\ 1 ora

sostituendo il valore di 1 (che significa un'ora) con il valore voluto, in ore intere, 

Il file di backup sarà salvato con un nome del genere

    Pippo_2017-06-28 10-02.xlsm

Dove il nome del file originario sia Pippo.xlsm e 2017-06-28 10 -02  rappresenti

l'ora di salvataggio nel formato yyyy-mm-gg oo:mm

===

Regards,

Norman