Inconsistant results from vb code exporting to text file

[Eprice]

Hi,
I am at a loss on what is going on or why. I have a database that imports an excel spreadsheet, makes some tables, exports the data to a text file and then combines the text just exported to another text file at the end. I do this for several different states. The problem I am having is that the whole program does not run as it should but never fails in the same place. One time it may be the Arkansas file that is incorrect but next time I try it Arkansas will be correct and Utah is incorrect and so on. If it was always the same file that was incorrect I could pinpoint the problem. Occasionally the whole file will be correct but rarely. Seems to me something must be running in the background causing the program to fail at different times. Does anyone have any ideas why it works sometimes and then doesn't? I have come to a dead end trying to make this work? Please HELP!!! Lisa

 

[TheAceMan1]

How are ya Eprice . . .

Don't you think [blue]we should see your code[/blue] that performs this task!

See Ya! . . . . . .

Be sure to see thread181-473997 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[JoeAtWork]

And also an example of one of the files you use as a data source where the problem has occurred.

Also, what do you mean by "fail"? Do you get an error message, does the file partially get completed, does it make a blank file with nothing in it, etc.?

So far you have not given any info that we can analyze.

 

[Eprice]

I was out for a couple days. I am attaching the code. This database also uses queries, macros and modules to do all of this. I have to create a text file to report our vin numbers. The code that does this is very long and I will show one of the modules. They are all the same just different names and a different record it is combining to cv.txt. How do I send the excel spreadsheet that this uses?


Private Sub cmdCreate_Click()
Dim r As Object, rPolr As Object, rProp As Object, rPrp1 As Object, rSubj As Object, rTrailer As Object
Dim rNum, sNum, x, rCnt, strCode
DoCmd.SetWarnings False

x = Format(DateAdd("w", 7, Date), "yyyymmdd")
rNum = 2
Dim MyName
MyName = Left(GetWinUser, 3)

'---DELETE OLD TABLE INFORMATION
DoCmd.OpenQuery "qryDeleteHeader"
DoCmd.OpenQuery "qryDeletePOLR"
DoCmd.OpenQuery "qryDeletePROP"
DoCmd.OpenQuery "qryDeletePRP1"
DoCmd.OpenQuery "qryDeleteSUBJ"
DoCmd.OpenQuery "qryDeleteTrailer"

'---IMPORT SPREADSHEET
'DELETE OLD IMPORT DATA
DoCmd.OpenQuery "qryDeleteSheet1"

'GET 1ST THREE DIGITS OF USER NAME TO DETERMINE WHERE TO IMPORT FROM
If MyName = "wpr" Then
DoCmd.TransferSpreadsheet acImport, , "Sheet1", "\\fs2nt\wprtest\access\accounting\CV\CV.xls", True
Else
DoCmd.TransferSpreadsheet acImport, , "Sheet1", "\\fs6nt\prod\CV\CV.xls", True
End If
'---MAKE tbl States
DoCmd.OpenQuery "qry MakeStates"

'---DELETE ALL PREVIOUS TXT FILES
If MyName = "wpr" Then
Kill "\\fs2nt\wprtest\access\accounting\CV\*.TXT"
Else
Kill "\\fs6nt\Prod\CV\*.TXT"
End If

'---UPDATE tblHeader WITH BEGIN DATE
Dim strPolNo, strTransDate
Set r = CurrentDb().OpenRecordset("tblHeader")
With r
r.AddNew
r.ReportBegin = x
r.Update
End With
Set r = Nothing

'---EXPORT tblHeader TO CV.txt
If MyName = "wpr" Then
DoCmd.RunMacro "ExportCVTest"
Else
DoCmd.RunMacro "ExportCV"
End If

'---OPEN tbl States AND MOVE TO FIRST RECORD
Dim strState, rState
Set rState = CurrentDb().OpenRecordset("tbl States")
With rState
.MoveFirst
Do While Not rState.EOF
strState = rState.[Garaged State]
txtState = strState
'MsgBox strState
'---RUN QUERY TO MAKE tblDetail
DoCmd.OpenQuery "qryDeleteDetail"
DoCmd.OpenQuery "qryMakeDetail"
Dim y
y = DCount("[Policy Number]", "tblDetail")
If y > 0 Then
'---RUN QUERIES TO UPDATE TABLES
DoCmd.OpenQuery "qryAppendPolr"
Sleep 300
DoCmd.OpenQuery "qryAppendProp"
Sleep 300
DoCmd.OpenQuery "qryAppendPrp1"
Sleep 300
DoCmd.OpenQuery "qryAppendSubj"
Sleep 300
DoCmd.OpenQuery "qry MakePolicyNo"

'---VARIABLES FOR PROGRESS METER
Dim sCount, n
sCount = DCount("[PolicyNo]", "tblPROP")
Dim LngTotal As Long
LngTotal = sCount

'---BEGIN LOOPING THROUGH TABLES TO TRANSFER RECORDS TO CV.txt
Dim Check
'Check = True
Do
rCnt = DCount("[PolicyNo]", "tblPROP")
Do While rCnt <> 0
'TURN ON SYSTEM PROGRESS METER TO SHOW PROGRESS TO USER FOR CV.txt CREATION
Screen.MousePointer = 11
SysCmd acSysCmdInitMeter, "Creating " & strState & " Text File, Please Wait...", LngTotal
LngTotal = 1
Set n = CurrentDb().OpenRecordset("tblPolicyNo")
n.MoveFirst

'POLR RECORD
xPolr:
'---UPDATE RECORD NUMBER AND GET INFO FOR QUERY
Set rPolr = CurrentDb().OpenRecordset("tblPOLR")
rPolr.MoveFirst
strCode = rPolr.TransactionCode
strPolNo = rPolr.PolicyNo
Forms![frmMainMenu]![txtPolNo] = strPolNo
strTransDate = rPolr.TransEffDate
Forms![frmMainMenu]![txtTransDate] = strTransDate
Forms![frmMainMenu]![txtCode] = strCode
Forms![frmMainMenu]![txtRecordNo].Value = Format(rNum, "000000000")
With rPolr
.Edit
![RecordNumber] = Format(rNum, "000000000")
.Update
End With

'---MAKE TEMPORARY POLR TABLE
DoCmd.OpenQuery "qry MakePolrTemp"

'---EXPORT tblPolrTemp TO Polr.txt
If MyName = "wpr" Then
DoCmd.RunMacro "ExportPOLRTest"
Else
DoCmd.RunMacro "ExportPOLR"
End If
'---CALL POLR
Polr
Sleep 700

'---DELETE TEMPORARY POLR TABLE
DoCmd.OpenQuery "qry DeletePolrTemp"
rNum = rNum + 1
Forms![frmMainMenu]![txtRecordNo].Value = Format(rNum, "000000000")

'PROP RECORD
xProp:
'---UPDATE RECORD NUMBER AND GET INFO FOR QUERY
Set rProp = CurrentDb().OpenRecordset("tblPROP")
rProp.MoveFirst
With rProp
.Edit
![RecordNumber] = Format(rNum, "000000000")
.Update
End With

'---MAKE TEMPORARY PROP TABLE
DoCmd.OpenQuery "qry MakePropTemp"
'---EXPORT tblPropTemp TO PROP.txt
If MyName = "wpr" Then
DoCmd.RunMacro "ExportPROPTest"
Else
DoCmd.RunMacro "ExportPROP"
End If
'---CALL PROP
Prop
Sleep 1000

'---DELETE TEMPORARY PROP TABLE
DoCmd.OpenQuery "qry DeletePropTemp"
rNum = rNum + 1
Forms![frmMainMenu]![txtRecordNo].Value = Format(rNum, "000000000")

'PRP1 RECORD
'---UPDATE RECORD NUMBER AND GET INFO FOR QUERIES
Set rPrp1 = CurrentDb().OpenRecordset("tblPRP1")
rPrp1.MoveFirst
With rPrp1
.Edit
![RecordNumber] = Format(rNum, "000000000")
.Update
End With

'---MAKE TEMPORARY PRP1 TABLE
DoCmd.OpenQuery "qry MakePrp1Temp"
'---EXPORT tblPrp1Temp TO PRP1.txt
If MyName = "wpr" Then
DoCmd.RunMacro "ExportPRP1Test"
Else
DoCmd.RunMacro "ExportPRP1"
End If
'---CALL PRP1
Prp1
Sleep 700

'---DELETE TEMPORARY PRP1 TABLE
DoCmd.OpenQuery "qry DeletePrp1Temp"
rNum = rNum + 1
Forms![frmMainMenu]![txtRecordNo].Value = Format(rNum, "000000000")

'SUBJ RECORD
'---UPDATE RECORD NUMBER AND GET INFO FOR QUERIES
Set rSubj = CurrentDb().OpenRecordset("tblSUBJ")
rSubj.MoveFirst
With rSubj
.Edit
![RecordNumber] = Format(rNum, "000000000")
.Update
End With

'---MAKE TEMPORARY SUBJ TABLE
DoCmd.OpenQuery "qry MakeSubjTemp"
'---EXPORT tblSubjTemp TO SUBJ.txt
If MyName = "wpr" Then
DoCmd.RunMacro "ExportSUBJTest"
Else
DoCmd.RunMacro "ExportSUBJ"
End If
'---CALL SUBJ
Subj
Sleep 700

'---DELETE TEMPORARY SUBJ TABLE
DoCmd.OpenQuery "qry DeleteSubjTemp"
rNum = rNum + 1
Forms![frmMainMenu]![txtRecordNo].Value = Format(rNum, "000000000")

'ADD 1 TO VARIABLE SO METER WILL MOVE UP ONE
SysCmd acSysCmdUpdateMeter, LngTotal
LngTotal = LngTotal + 1
n.MoveNext

'--OPEN QUERY TO GET COUNT OF ANY MORE RECORDS IN tblProp
Dim strX, stry, strEnd
strX = DCount("[PolicyNo]", "qryGetDuplicatePolr")
stry = DCount("[PolicyNo]", "qryGetDuplicateProp")
rCnt = DCount("[PolicyNo]", "tblPROP")
If rCnt = 0 Then
Check = False
Exit Do
End If
If strX = 1 And stry = 1 Then
GoTo xPolr
ElseIf strX = "" And stry = "" Or strX = 0 And stry = 0 Then
GoTo xPolr
Else
GoTo xProp
End If
Loop
Loop Until Check = False
Set n = Nothing
DoCmd.OpenQuery "qry DeletePolNo"
DoCmd.OpenQuery "qryDeletePOLR"
DoCmd.OpenQuery "qryDeletePROP"
DoCmd.OpenQuery "qryDeletePRP1"
DoCmd.OpenQuery "qryDeleteSUBJ"
strCode = ""
strPolNo = ""
strTransDate = ""
End If

rState.MoveNext
Loop
End With

'Trailer Record
rNum = rNum
sNum = rNum - 2
Forms![frmMainMenu]![txtRecordNo].Value = Format(rNum, "000000000")
' ---UPDATE RECORD NUMBER & TOTAL RECORDS FOR tblTrailer
Set rTrailer = CurrentDb().OpenRecordset("tblTrailer")
With rTrailer
.AddNew
![RecordNumber] = Format(rNum, "000000000")
![TotalRecords] = Format(sNum, "000000000")
.Update
End With
Set rTrailer = Nothing
' ---EXPORT tblTrailer TO Trailer.txt
If MyName = "wpr" Then
DoCmd.RunMacro "ExportTrailerTest"
Else
DoCmd.RunMacro "ExportTrailer"
End If
'---CALL Trailer
Trailer

'CLEAR HIDDEN TEXT BOXES ON MAIN MENU
Forms![frmMainMenu]![txtTransDate] = ""
Forms![frmMainMenu]![txtCode] = ""
Forms![frmMainMenu]![txtRecordNo].Value = ""

'TURN OFF PROGRESS METER
Screen.MousePointer = 0
SysCmd acSysCmdRemoveMeter
Set n = Nothing

MsgBox "CV.txt has been created and stored in the S:\Prod\CV folder"
DoCmd.SetWarnings True
DoCmd.Quit
End Sub


One module:
Public Sub Polr()
'---APPEND POLR.txt to CV.txt
Dim rSource As Integer
Dim rDest As Integer
Dim Temp As String
Dim txtName
txtName = Forms![frmMainMenu]!txtName

On Error GoTo ErrorHandler
If txtName = "wpr" Then
rDest = FreeFile()
Open "\\fs2nt\wprtest\Access\Accounting\CV\CV.txt" For Append As rDest

rSource = FreeFile()
Open "\\fs2nt\wprtest\Access\Accounting\CV\POLR.txt" For Input As rSource

Do While Not EOF(rSource)
Line Input #rSource, Temp
Print #rDest, Temp
Loop
Else
rDest = FreeFile()
Open "\\fs6nt\Prod\CV\CV.txt" For Append As rDest

rSource = FreeFile()
Open "\\fs6nt\Prod\CV\POLR.txt" For Input As rSource

Do While Not EOF(rSource)
Line Input #rSource, Temp
Print #rDest, Temp
Loop
End If


CloseFiles:
Close #rDest
Close #rSource
Exit Sub

ErrorHandler:
MsgBox "Error # " & Err & ": " & Error(Err)
Resume CloseFiles
End Sub

If you need me to zip the database I can send it to you.
Thanks
Lisa