Eliminare file ( creati come copie di Backup) di database Access più vecchi di 30 giorni.

Question

Buongiorno a tutti.

Con la sottoelencata routine (abbinata ad un pulsante di comando) effettuo giornalmente la copia  di Backup di un  database di Access (monoutenza) e salvo il file in una cartella apposita.

Public Function BackupOnOpen()

' ***  CHANGE THE FOLLOWING LINE TO MATCH YOUR BACKUP DESTINATION

' Ensure you have a \ on the end of the pathname.

Const BACKUP_PATH = "C:\Accessi"

On Error GoTo BackupOnOpen_Err

If DCount("BackupDate", "tblBackupDetails", "BackupDate = date()") <> 0 Then

 Exit Function

End If

Dim strSourcePath As String

Dim strSourceFile As String

Dim strBackupFile As String

strSourcePath = GetFileName(CurrentDb.Name, False)   '  false means we want pathname

strSourceFile = GetFileName(CurrentDb.Name, True)    '  true means we want filename

strBackupFile = "BackupDB-" & Format(Date, "yyyy-mm-dd") _

& "_" & Format(Time, "hh.mm.ss") & "-" & strSourceFile

Dim fso

Set fso = CreateObject("Scripting.FileSystemObject")

fso.CopyFile strSourcePath & strSourceFile, BACKUP_PATH & strBackupFile, True

MsgBox "Backup Completato!"

Set fso = Nothing

DoCmd.SetWarnings False

Dim SQL As String

SQL = "INSERT INTO tblBackupDetails " _

  & "(BackupDate, ComputerName, BackupFolder, Filename) " _

  & "VALUES ('" & Date & "', '" & Environ("COMPUTERNAME") _

  & "', '" & BACKUP_PATH & "', '" & strBackupFile & "');"

DoCmd.RunSQL SQL

SQL = "DELETE * FROM tblBackupDetails WHERE BackupDate < date() - 30;"

DoCmd.RunSQL SQL

DoCmd.SetWarnings True

BackupOnOpen_Exit:

Exit Function

BackupOnOpen_Err:

MsgBox Err.Description, , "BackupOnOpen()"

Resume BackupOnOpen_Exit

End Function

Chiedo il vostro aiuto per poter creare ( all'interno delle stessa routine oppure con un'altra a parte) una sub che elimini i files più vecchi di 30 gg. nell'apposita cartella, dove sono contenuti i files di Backup.

Ringrazio chi mi aiuta in questo.

Ciao Nicola.

Answer 1

Ciao Sandro, grazie come sempre per le tue spiegazioni molto intuitive e professionali. Sposo la tua idea di effettuare prima la compattazione e poi il backup da operazione pianificata da s.o. ho già usato questo procedimento per altro db multiutenza ed in rete. Adatto tutto seguendo le tue indicazioni e ti aggiorno fra qualche giorno. Ciao Nicola.

Answer 2

ciao Nicola,

la soluzione che proponi potrebbe anche andare bene a patto che i files backup non vengano mai modificati, questo perché la funzione instrinseca FileDateTime restituisce la data di creazione o la data di ultima modifica, quindi se esegui modifiche ai back up's potresti non cancellare tutti i files.

Visto che concateni la data nel nome del file potresti valutare nello statement if quella data ( estraendola) e non quella restituita da FileDateTime.

https://msdn.microsoft.com/it-it/vba/language-reference-vba/articles/filedatetime-function

Per il resto il back up lo eseguirei a database chiuso schedulando un'operazione pianificata del sistema operativo.

Vedrei bene anche la sua compattazione prima del back up.

Come regola generale ti consiglio di  evitare l'uso degli oggetto esterni quando puoi, mi riferisco al FSO ( valuta fileCopy è nativa).

Per quanto all'esecuzione di action queries valuta il medoto execute in tal modo puoi omettere le istruzioni per l'eliminazione dei messaggi di avviso.

HTH.

[...]

Grazie per tutto quello che fate ( hai fatto e fai ) per me.

[...]

Prego, finchè ci si diverte, siamo qua :-)!

Ciao, Sandro.

Answer 3

Ciao Sandro, ho risolto, l'ho testata e mi elimina i files .accdb più vecchi di 30 gg.

Sub CancellaFileVecchi()

  Dim MyFile As String

  Dim strFilePath As String

  strFilePath = "C:\Accessi - Copia"

  MyFile = Dir(strFilePath & "*.accdb")

  Do While Len(MyFile) > 0

    If FileDateTime(strFilePath & MyFile) < (Date - 30) Then

      Kill strFilePath & MyFile

    End If

    MyFile = Dir

  Loop

 End Sub

Ho scoperto un'altra funzione che non conoscevo: FileDateTime.

Comunque quanto a questo:

ciao Nicola,

premesso che rivedrei personalmente anche la routine di back up

cosa vorresti consigliarmi, spiegami e fammi capire il perché.

Grazie per tutto quello che fate ( hai fatto e fai ) per me.

Ciao Nicola.

Answer 4

Ciao Sandro, buongiorno, grazie per la tua assistenza e presenza.

Ho inserito questo codice per eliminare i file più vecchi di 30 giorni ma ottengo il messaggio di errore che allego.

Private Sub CancellaFileVecchi()

 On Error GoTo EH:

     Dim strFileName As String

     Dim DirectoryName As String

     DirectoryName = "C:"

     strFileName = Dir("C:\Accessi\*accdb")

     Do While strFileName <> ""

         If Date - 30 > CDate(Mid(strFileName, Len(strFileName) - 21, 10)) Then

             Kill DirectoryName & strFileName

         End If

         strFileName = Dir()

     Loop

     Exit Sub

EH:

     If Err.Number = 13 Then

         Resume Next

     Else

         MsgBox Err.Number & " " & Err.Description

         Exit Sub

     End If

 End Sub

Cosa sbaglio, fammelo capire per favore ( come hai fatto finora ).

Ciao Nicola.

Answer 5

ciao Nicola,

premesso che rivedrei personalmente anche la routine di back up, che ne dici di proporre qualcosa di tuo che esegua quanto richiedi?

Anche non funzionante, mostraci i tentativi.

Ciao, Sandro.