I have been putting backup routines in my projects to save whatever file is important to the application.
If the user selects to backup to the same drive as the original file then I warn him that it's a bad idea.
But that doesn't work if he chooses to backup to a different partition on the same physical hard drive.
So I want to warn if backing up to the same physical drive.
Answer I need:
How do I determine what physical drive a partition is part of?
Code:Public Function BackupProjectFile() As Long Dim sMsg As String Dim sBackupFilename As String Dim nReturn As Long Dim FSO As New FileSystemObject Dim sCurrentDrive As String Dim sBackupDrive As String On Error GoTo errHandler ' Returns Error Code. sMsg = "In the event of Drive failure, both the original file and the backup file may be lost." & vbCrLf & "Continue with backup operation?" & DBL_RETURN sMsg = sMsg & "Click Yes to continue or No to select a different path to backup your Project." Top: If sBackupFilename = vbNullString Then sBackupFilename = ProjectFilename sBackupFilename = GetFileName(FILE_SAVE, sBackupFilename, 0, WEBMASTER_Project_v2_FILE_FILTERS, BackupPath(sBackupFilename), vbNullString, "wpj2") If sBackupFilename = vbNullString Then Exit Function sCurrentDrive = FSO.GetDriveName(ProjectFilename) sBackupDrive = FSO.GetDriveName(sBackupFilename) If sCurrentDrive = sBackupDrive Then nReturn = MsgBox(sMsg, vbYesNoCancel + vbQuestion, APP_TITLE) Select Case nReturn Case Is = vbYes ' Do nothing Case Is = vbNo GoTo Top Case Is = vbCancel Exit Function End Select End If nReturn = BackupFile(ProjectFilename, sBackupFilename) If nReturn <> 0 Then Err.Raise nReturn MsgBox ProjectFilename & DBL_RETURN & "successfully backed up to" & DBL_RETURN & sBackupFilename & ".", vbInformation, APP_TITLE Registry.SaveSetting "StartUp", "Backup Path", GetFolder(sBackupFilename) Set FSO = Nothing ' Return 0 Exit Function errHandler: Dim nErrReturn As Long Dim nErr As Long nErr = Err nErrReturn = ErrorHandler(Error, nErr, vbNullString, "bWebmasterUtilties2.BackupProjectFile()") If nErrReturn = vbRetry Then Resume BackupProjectFile = nErr Set FSO = Nothing End Function




Reply With Quote