Calling all Experts!!!!

S

Scott Burke

I have 3 computers. This program works fine on two computer but NOT on one.
computer1 = does not work
computer2 = works
computer3 = works

I wont to start by saying that the code (below) worked perfectly untill we
hit XP. Then I had to start using the FreeFile command. Now things just
don't seem to work.

The Big problem:
The code generates a file on disk.
When computer 1 generates the file it looks like this:
Record1

Record2

Record3
When computers 2 & 3 generates the file it looks llike this:
Record1
Record2
Record3

It is the same code!!!!!!!! Why am I getting two different outputs!
The code below is the code in question:

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
Dim IntFile As Integer

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
Rem XP does not like to use #1
Rem That is why YOU dont use it.
IntFile = FreeFile()
Close IntFile
Open work1 For Output As IntFile
'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
Print #IntFile, 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
Close IntFile
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
Close IntFile
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
 
J

John Nurick

It appears that Computer 2 has Access 2003 while the others have Access
2002. Is that right? But your code should produce the same results in
any recent versions of Access and Windows, assuming it's getting exactly
the same data.

Your procedure appears to take a table or query name (or maybe SQL
statement) as its first argument, so it's designed to be used with
differing datasets. Does the problem occur consistently regardless of
the dataset that's being exported, or does it only happen with one or
some datasets?

What I'd do next is run the procedure on Computer 1 and one other,
taking care that each is processing _exactly_ the same data so the two
output files should be identical.

I'd then compare the two output files to identify exactly what the
differences are in terms of the individual bytes in the file(s). That
may give someone a clue what's happening.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top