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