Losing the A: Drive.

[Scott Burke]

I have many programs that writes files to the A:\ Drive.
The Clearwin program seems to be the only prgram with a problem.

Here is what is happening. The Clearwin program makes "MPA" disks. Not
important what "MPA" is. The program works fine. The queries fill the table
and then the program creates a space delimited file on a floppy disk.

The problem is: At lest once or twice a week the A: drive gets lost! What I
mean by that is the program can't see the floppy drive. No other program can
use the floppy drive either. It looks like somthing has taken over the
floppy drive and refuses to relese the A:\ drive. A reboot is the only way
to release it.

All the other programs that use the floppy drive don't have this problem.
However this program is the only one that uses low level commands. See
below.
I wonder, Am I forgetting to do something is is this code that is causeing
the A:\ Drive to lockup???

Scott Burke




Rem This function will save the tables to SDF format on the A: drive.
Function save_all(thename As String, thetotal As Long, TheDate As Date, _
thefile As String, DateType As String)
On Error GoTo save_all_error

Dim Db As DAO.Database
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Dim work1 As String
Dim disknum As Double
Dim i As Long
Dim strMsg As String
Dim progMeter As Variant
Dim rec_count As Long
Dim disk_count As Long
Dim intRecCount As Integer
Dim Response

DoCmd.Hourglass True
Set Db = CurrentDb()
Set rs = Db.OpenRecordset(thename)

Rem Set up working varibles.
work1 = Space(1)
disknum = 0
disk_count = 1

Rem Move to top of recordset
rs.MoveLast
rs.MoveFirst

Rem Setup the program meter!
rec_count = 1
progMeter = SysCmd(acSysCmdInitMeter, "Creating Disk ", rs.RecordCount)

Rem Close any thing that maybe open in channel #1
Close #1

Rem Give the user the information they will need.
intRecCount = DCount("*", thename)
disknum = intRecCount / thetotal

If Not disknum = Int(disknum) Then
disknum = Int(disknum) + 1
End If

DoCmd.Hourglass False
strMsg = Chr(13) & Chr(10)
strMsg = strMsg & "Creating Agent Disk " & Trim(thefile) & Chr(13) &
Chr(10)
strMsg = strMsg & Chr(13) & Chr(10)
strMsg = strMsg & "Total Records: " & intRecCount & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10)
strMsg = strMsg & "You will need ( " & Trim(Str(disknum)) & " ) disks
for creating "
strMsg = strMsg & "this disk."
strMsg = strMsg & Chr(13) & Chr(10)
Response = MsgBox(strMsg, vbOKCancel, "Clearance Message")
DoCmd.Hourglass True

If Response = vbCancel Then
rs.Close
Set rs = Nothing
Db.Close
Set Db = Nothing
Exit Function
End If


Do While Not rs.EOF And Response <> vbCancel
Rem Open the work file in channel #1
If disk_count = 1 Then
work1 = Trim(thefile)
Else
work1 = Mid(thefile, 1, Len(thefile) - 4) &
Trim(Str(disk_count)) + _
Right(thefile, 4)
End If
disk_count = disk_count + 1
Open work1 For Output As #1
For i = 1 To thetotal
Rem Check for EOF
If Not rs.EOF Then
Rem lets do it!!!
work1 = Space(0)
For Each fld In rs.Fields
Rem To be 100% correct... You must check for all
Rem field types. However, My export files use
Rem TEXT and Date field types only.
If IsNull(fld.Value) Then
work1 = work1 & sizestr(fld.Value, fld.Size)
Else
If fld.Type = dbDate Then
work1 = work1 & sizedate(fld.Value, DateType)
Else
work1 = work1 & sizestr(fld.Value, fld.Size)
End If
End If
Next fld
work1 = Mid(work1, 1, Len(work1) - 2)
Print #1, work1
rs.MoveNext
work1 = ""
Else
Rem If EOF is reached then end the loop.
i = thetotal
End If
Rem Update the program meter.
rec_count = rec_count + 1
'progMeter = SysCmd(acSysCmdUpdateMeter, rec_count)
Next
If Not rs.EOF Then
Close #1
strMsg = Chr(13) & Chr(10)
strMsg = strMsg & "Please put another Disk in Drive A:\."
strMsg = strMsg & Chr(13) & Chr(10)
Response = MsgBox(strMsg, vbOKCancel, "Save File")
End If
If rs.EOF Then
Close #1
End If
Loop

Rem Clear the program meter.
progMeter = SysCmd(acSysCmdClearStatus)
DoCmd.Hourglass False
strMsg = Chr(13) & Chr(10)
strMsg = strMsg & "Files are done copying."
strMsg = strMsg & Chr(13) & Chr(10)
MsgBox strMsg, vbOKOnly, "Finished"
rs.Close
Set rs = Nothing
Db.Close
Set Db = Nothing

Rem exit function to avoid running the error code:
Exit Function

save_all_error:
strMsg = Chr(13) & Chr(10)
strMsg = strMsg & "There was an error. "
strMsg = Chr(13) & Chr(10)
strMsg = strMsg & "Try again and use an other disk."
strMsg = strMsg & Chr(13) & Chr(10)
MsgBox strMsg, vbOKOnly, "Error"
DoCmd.Hourglass False

End Function

 

[Douglas J. Steele]

You should never hard-code the file number as you are:

Open work1 For Output As #1

Rather, you should use the FreeFile function to return an appropriate file
handle to use:

Dim intFile As Integer

intFile = FreeFile()
Open work1 For Output As #intFile

I'd also recommend writing the file(s) to the hard drive, and then copying
them to diskette, rather than writing directly to diskette.

 

[Scott Burke]

Hi Douglas,
I wrote this function many many many moons ago and I followed
MS Help. I guess that was my first, second, and thrid mistake.

I am going to give this a try. This program is run once a week, It could be
next Monday before I get back to you.

Scott Burke