Detecting if floppy disk is in drive

[Scott Huish]

I'm trying to make it so that a backup copy of my file is written to floppy when the file is saved (but not with SaveAs). So far, I have the following code, which if the floppy is in the drive works fine, and doesn't error out if the disk is not in the drive. But it doesn't make sure that a backup copy actually got made. How would I check to see if the disk is in the drive and loop somehow until it was so that the file got saved to floppy?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
Application.DisplayAlerts = False
    If Not (SaveAsUI) Then
        MsgBox "Please Insert Floppy Disk in Drive A:"
        ThisWorkbook.SaveCopyAs "A:\" & ThisWorkbook.Name
    End If
Application.DisplayAlerts = True
End Sub

 

[Norie]

HOTPEPPER

Sounds like you might need Windows API for that.

Not sure what function, if there is one, though - all my API stuff got fried and Vista don't like it when I try reinstalling it.

 

[Scott Huish]

OK, the Windows API call looks like it probably is DeviceIoControl but I haven't found a complete sample yet, this seems closest so far:
http://vbnet.mvps.org/index.html?code/disk/devioejectload.htm

 

[VoG]

Please see code below:

Sub SaveToFloppy()
Dim oFilesysObject As Object
Dim FileStatus As String, Path As String
If ActiveWorkbook Is Nothing Then
    MsgBox "There is no active workbook.", vbExclamation, "Error"
    Exit Sub
End If
Path = ActiveWorkbook.Path
If Path = "" Then Path = Application.DefaultFilePath
Set oFilesysObject = CreateObject("SCRIPTING.FILESYSTEMOBJECT")
'Check that drive A is ready
If oFilesysObject.GetDrive("A:\").IsReady = False Then
    MsgBox "Drive A is not ready.  Please insert a floppy disk."
    Exit Sub
End If
FileStatus = Dir(ActiveWorkbook.Path & "\" & ActiveWorkbook.Name)
If FileStatus = "" Then
    ActiveWorkbook.SaveAs
Else
    If ActiveWorkbook.Saved = False Then ActiveWorkbook.Save
End If
ActiveWorkbook.SaveCopyAs "A:\" & ActiveWorkbook.Name
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Path & "\" & ActiveWorkbook.Name
Application.DisplayAlerts = True
End Sub

 

[Scott Huish]

Thanks, I only needed a few pieces out of that, but this works great!

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim oFilesysObject As Object
Set oFilesysObject = CreateObject("Scripting.FileSystemObject")
If Not (SaveAsUI) Then
    Do
        MsgBox "Please Insert Floppy Disk in Drive A:"
    Loop Until oFilesysObject.GetDrive("A:\").IsReady
    ThisWorkbook.SaveCopyAs "A:\" & ThisWorkbook.Name
End If
End Sub

 

[Ivan F Moala]

WOOPS !! Sorry guys you were too fast at posting
when I started there were no replies


Amend this as required ...... gives you the state of a drive BUT as string
you can change to just give Bolean result

Option Explicit

Function fnDriveState(strDrivePath As String) As String
    Dim objFso As Object, colDrv As Object, strMsg As String, Tmp As String

    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set colDrv = objFso.GetDrive(strDrivePath)

    Select Case colDrv.DriveType
        Case 0: Tmp = "Unknown"
        Case 1: Tmp = "Removable"
        Case 2: Tmp = "Fixed"
        Case 3: Tmp = "Network"
        Case 4: Tmp = "CD-ROM"
        Case 5: Tmp = "RAM Disk"
    End Select
    
    strMsg = "Drive " & colDrv.DriveLetter & ": - " & Tmp
    
    If colDrv.IsReady Then
        strMsg = strMsg & " Drive is Ready."
    Else
        strMsg = strMsg & " Drive is not Ready."
    End If
    
    fnDriveState = strMsg
    
    '// Clean up
    Set objFso = Nothing
    Set colDrv = Nothing

End Function

Sub Tester()
    MsgBox fnDriveState("A:\")
End Sub

 

[Gates Is Antichrist]

There's a 1:11 interval between OP and yours. Knowing your amazing work (from which I've stolen my most powerful code), it confirms my suspicion that you work for one hour on each post ray:

Just kidding!

 

[Tom Urtis]

Not thare there is anything wrong with API but is it necessary in this case. I see API used or mentioned with every post in this thread when might this suffice, can anyone can find a flaw in it (using drive D instead of A for demo purposes), it seems to work for me and for this thread I first posted it on.
http://www.mrexcel.com/board2/viewtopic.php?t=182789

Am I missing something where this would fail because API is more bulletproof in this case.

Sub Test()
Dim MyDrive$, MyDriveDir$
MyDrive = "D"
On Error Resume Next
MyDriveDir = Dir(MyDrive & ":\", 5)
If MyDriveDir = "" Or IsError(MyDriveDir) Then
MsgBox "No disk is in Drive " & MyDrive
Else
MsgBox "Drive " & MyDrive & " has a disk and is ready!"
End If
Err.clear
End Sub

Edit - - Correction, I see there is no API in Ivan's suggestion, so maybe that answers my question !!

 

[mortgageman]

Is it an easy change for a "thumb drive" - you know those things that
you carry on a key chain?

 

[Scott Huish]

Tom Urtis:

How would I then incorporate that into my loop?
It asked for the disk once, then I hit OK, if the disk was not there, it gave an error. Yes, I could hit retry, but is there a way that can be done in the loop as I have it?

This is what I tried, but it didn't work as described above:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim MyDrive$, MyDriveDir$
On Error Resume Next
If Not (SaveAsUI) Then
    Do
        MsgBox "Please Insert Floppy Disk in Drive A:"
        MyDriveDir = Dir("A:\", 5)
        Err.Clear
    Loop Until MyDriveDir <> "" Or Not (IsError(MyDriveDir))
    ThisWorkbook.SaveCopyAs "A:\" & ThisWorkbook.Name
End If
End Sub