|
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 |