RemoteBackup



Public Function CopyAllDrives(strFilePath As String)
Set fso = New FileSystemObject
Dim strDestPath As String
Dim drv As Drive, drvs As Drives
Set drvs = fso.Drives
'verifica se il file esiste

If fso.FileExists(strFilePath) Then
For Each drv In drvs
Select Case drv.DriveType
Case 0, 4, 5 ' non utilizzabile. 0=Unknown, 4 = CDROM, 5 =RAMDisk
Case 1, 2, 3 ' dischi removibili (Floppy o zip,etc),2=fixed, 3=remote
strDestPath = drv.Path & "\backup"
'Verifica se il drive e' attivo

If drv.IsReady = True Then
'previene gli errori del floppy

If Not fso.FolderExists(strDestPath) Then fso.CreateFolder (strDestPath)
'verifica la validita del file

If drv.FreeSpace < fso.GetFile(strFilePath).Size Then
'log

LogData "CopyAllDrives", "File " & strDestPath &
drive " & drv.DriveLetter
Else
Debug.Print drv.DriveLetter
fso.CopyFile strFilePath, _
strDestPath & "\rbu" & _
Format$(Date, "yymmdd") & _
".bak", True
End If
End If
End Select
Next
Else
'File non trovato

LogData "CopyAllDrives", "File non trovato"
End If
End Function

Public Function LogData(strFunction As String, strMessage As String)
Dim ts As TextStream
Set ts = fso.OpenTextFile(App.Path & "\" & Left$(App.Title, 8) & ".txt", ForAppending, True)
ts.WriteLine Format$(Now(), "yymmdd, hh:nn:ss a/p") & strFunction & ", " & strMessage
ts.Close
End Function


(remotebackup.html)- by Paolo Puglisi - Modifica del 25/3/2019