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
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
