Detecting if floppy disk is in drive

Scott Huish

MrExcel MVP
Joined
Mar 17, 2004
Messages
20,301
Office Version
  1. 365
Platform
  1. Windows
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?

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

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
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. :rolleyes:
 
Upvote 0
Please see code below:

Code:
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
 
Upvote 0
Thanks, I only needed a few pieces out of that, but this works great!

Code:
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
 
Upvote 0
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

Code:
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
 
Upvote 0
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 :pray:

Just kidding!
 
Upvote 0
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.


Code:
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 !!
 
Upvote 0
Is it an easy change for a "thumb drive" - you know those things that
you carry on a key chain?
 
Upvote 0
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:

Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top