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

'Assumes:You need to either set up a ref

' erence to the Microsoft Scripting runtim

' e (scrrun.dll) to the project, or declar

' e a new instance like this-- Set fso = C

' reateObject("Scripting.FileSystemObject"

' ). Also, I threwin the logger I use to t

' rack errors or problems.

'

'Side Effects:Thi scan fill up your hard

' drives fairly fast if you're copying lar

' ge files. I'll repost later with a file

' cleaner.

'











( remotebackup.html )- by Paolo Puglisi - Modifica del 17/12/2023