Nested loop

K

KJ-clueless

I am attempting to loop through a couple of different recordsets in
completing the import of 9 seperate text files. The following function works
but does not loop through the file name and only completes on one filename.

Please point me in the right direction as this is new to me.

*** Start code ****

Option Compare Database

Function importOPR()
On Error GoTo myerror


' The purpose of this module is to import Operations Portfolio Review
(OPR) data
Dim cnnCurrent As New ADODB.Connection
Dim rstimport As New ADODB.Recordset
Dim rstsuccess As New ADODB.Recordset
Dim rstfilename As New ADODB.Recordset
Dim MYDATE As Date
Dim cango As Boolean
Dim importdate As Date
Dim MYFILE As String
Dim MYIMPORTSPEC As String

Set cnnCurrent = CurrentProject.Connection


MYDATE = Date - 14

If IsNull(Forms!frmOPUS!txtdate) Then

rstimport.Open "SELECT max(import_date) as maxdate FROM
tblImportStatus WHERE success=""" & "Success" & """", cnnCurrent,
adOpenStatic, adLockReadOnly
MYDATE = rstimport!maxdate
Else
MYDATE = Forms!frmOPUS!txtdate
End If

filepath = "J:\OPR\OPR REPORTING\OPR Text files\"
rstfilename.Open "select * from tblfilenames", cnnCurrent, , adLockReadOnly
rstfilename.MoveFirst
Do Until rstfilename.EOF


MYFILE = rstfilename!filename
MYIMPORTSPEC = rstfilename!importspec

Do Until (MYDATE > Date - 1)

filename = MYFILE & DatePart("m", MYDATE) & DatePart("d", MYDATE) &
DatePart("yyyy", MYDATE) & ".txt"
importdate = DatePart("m", MYDATE) & "/" & DatePart("d", MYDATE) &
"/" & DatePart("yyyy", MYDATE)
If Dir$(filepath & filename) <> "" Then
cango = True
rstsuccess.Open "select * from tblimportstatus where
import_date = #" & MYDATE & "#", cnnCurrent, adOpenStatic, adLockReadOnly
Do Until rstsuccess.EOF Or cango = False

If rstsuccess.BOF And rstsuccess.EOF Then
cango = True
ElseIf rstsuccess!success = "Success" Then
cango = False
Else
cango = True
End If
rstsuccess.MoveNext

Loop
rstsuccess.Close

If cango = True Then
DoCmd.TransferText acImportDelim, MYIMPORTSPEC, "TblData",
filepath & filename, False, ""
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblImportStatus (import_name,
import_date, success, date_stamp) VALUES(""" & filepath & filename & """,#" &
importdate & "#, """ & "Success" & """, #" & Now() & "#)"
DoCmd.SetWarnings True
Else
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblImportStatus (import_name,
import_date, success, date_stamp) VALUES(""" & filepath & filename & """,#" &
importdate & "#, """ & "Previously Success" & """, #" & Now() & "#)"
DoCmd.SetWarnings True
End If
Else
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblImportStatus (import_name,
import_date, success, date_stamp) VALUES(""" & filepath & filename & """,#" &
importdate & "#, """ & "Failed-File does not exist" & """, #" & Now() & "#)"
DoCmd.SetWarnings True
End If
MYDATE = DateAdd("d", 1, MYDATE)
rstfilename.MoveNext
Loop

Loop
rstfilename.Close
Exit Function
myerror:
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblImportStatus (import_name, import_date,
success, date_stamp) VALUES(""" & filepath & filename & """,#" & Now() & "#,
""" & "Failed-" & Err.Description & """, #" & Now() & "#)"
DoCmd.SetWarnings True

'MsgBox "Importing stopped at " & mydate, vbOKOnly, ""
End Function
*** end code ***
 
K

KJ-clueless

I tried to place the re-initialization in a couple of different locations but
with the same results as before. Where would you suggest I insert the
re-initializing variable?
 
K

KJ-clueless

Damian S.

Thanks, for your help... I suspected this error all along but could not for
the life of me figure it out. I've found my error(s), #1 I closed the
filename recordset prematurely and I failed to re-initialize the MYDATE
variable, which now having corrected both of these problems it is looping
just fine through the loop and sub-loop.
 

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