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 ***
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 ***