Why am i getting this error and more importantly how do i fix it? Here is my code. It runs fine until I modify it and add a new field to be imported into the DB. I will show the original code that runs fine then the modifed code (with the new field to be pulled in) which is giving me the error. It breaks at this line of code
I only change 2 lines of code from the original to the new code: the lines are :
and
original code - runs fine:
*************** *************** ***************
*************** *************** **************
*************** *************** ***************
modified code (doesnt run - gives me the error)
LoanNo = NewImportRS.Fie lds(1)I only change 2 lines of code from the original to the new code: the lines are :
DoCmd.TransferS preadsheet acImport, , "TEMP2", FileLocation, True, "A1:F10000"and
Code:
strSQL = "INSERT INTO tblexceptions ([LoanNumber], [ExceptionItem], [ExceptionIssue], [Investor], [ExceptionType], [IssueID]) VALUES ('" & LoanNo & "', '" & NewImportRS.Fields(2) & "', '" & NewImportRS.Fields(3) & "', " & InvestorNo & ", '" & NewImportRS.Fields(5) & "','" & NewImportRS.Fields(6) & "')"
original code - runs fine:
Code:
Public Function ImportDataFile(InvestorNo As Integer, FileLocation As String)
Dim SqlStr As String
Dim db As Database
Dim ExistingRS As DAO.Recordset
Dim NewImportRS As Recordset
Dim CommentHistoryRS As DAO.Recordset
Dim Criterion As String, HistoryCriterion As String
Dim LoanNo As String
Dim CommenntString As String
Dim ImportCount As Long, ImportTotaltoImport As Long, CountTemp As Double
strSQL = "Delete * from [TEMP]"
DoCmd.RunSQL strSQL
DoCmd.TransferSpreadsheet acImport, , "TEMP2", FileLocation, True, "A1:E10000"
strSQL = "INSERT INTO [TEMP] Select * from TEMP2"
DoCmd.RunSQL strSQL
Set db = CurrentDb
Set ExistingRS = CurrentDb.OpenRecordset("tblexceptions", dbOpenDynaset)
Set NewImportRS = CurrentDb.OpenRecordset("TEMP")
SqlStr = "Delete * from [TEMP] where isnull(" & NewImportRS.Fields(1).Name & ") or " & NewImportRS.Fields(1).Name & "= ''"
DoCmd.RunSQL SqlStr
NewImportRS.MoveLast
ImportTotaltoImport = NewImportRS.RecordCount
NewImportRS.MoveFirst
ImportCount = 0
Do While Not NewImportRS.EOF
LoanNo = NewImportRS.Fields(1)
'Creates a 10 Digit Loan Number
Do While Len(LoanNo) < 10
LoanNo = "0" & LoanNo
Loop
Criterion = "[Loannumber] = '" & LoanNo & "' AND [ExceptionItem] = '" & NewImportRS.Fields(2) & "' AND [ExceptionIssue] = '" & NewImportRS.Fields(3) & "' and [Investor] = " & InvestorNo
'Looks for exisitng record of exception
ExistingRS.FindFirst Criterion
'Add record of exception that is not already present
If ExistingRS.NoMatch Then
ExistingRS.Close
Set ExistingRS = Nothing
strSQL = "INSERT INTO tblexceptions ([LoanNumber], [ExceptionItem], [ExceptionIssue], [Investor], [ExceptionType]) VALUES ('" & LoanNo & "', '" & NewImportRS.Fields(2) & "', '" & NewImportRS.Fields(3) & "', " & InvestorNo & ", '" & NewImportRS.Fields(5) & "')"
DoCmd.RunSQL strSQL
Set ExistingRS = CurrentDb.OpenRecordset("tblexceptions", dbOpenDynaset)
'ExistingRS.Requery '***********
End If
ExistingRS.FindFirst Criterion
If Not ExistingRS.NoMatch Then
strSQL = "SELECT * from tblInvestorComments where [exceptionid] = " & ExistingRS.Fields("ExceptionID")
Set CommentHistoryRS = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not IsNull(NewImportRS(3)) Then
commentString = NewImportRS.Fields(4)
commentString = Replace(commentString, "'", "-")
commentString = Replace(commentString, Chr(34), "$")
HistoryCriterion = "[Comments] = '" & commentString & "'"
CommentHistoryRS.FindFirst (HistoryCriterion)
If CommentHistoryRS.NoMatch Then
If Not IsNull(NewImportRS.Fields(4)) Then
strSQL = "INSERT INTO tblInvestorComments ([exceptionid], [Comments]) VALUES ('" & ExistingRS.Fields("ExceptionID") & "', '" & commentString & "')"
DoCmd.RunSQL (strSQL)
End If
End If
End If
End If
NewImportRS.MoveNext
ImportCount = ImportCount + 1
CountTemp = UpdateStatus(ImportCount, ImportTotaltoImport, CountTemp)
Loop
Set ExistingRS = Nothing
Set NewImportRS = Nothing
DoCmd.DeleteObject acTable, "TEMP2"
End Function
*************** *************** **************
*************** *************** ***************
modified code (doesnt run - gives me the error)
Code:
Public Function ImportDataFile(InvestorNo As Integer, FileLocation As String)
Dim SqlStr As String
Dim db As Database
Dim ExistingRS As DAO.Recordset
Dim NewImportRS As Recordset
Dim CommentHistoryRS As DAO.Recordset
Dim Criterion As String, HistoryCriterion As String
Dim LoanNo As String
Dim CommenntString As String
Dim ImportCount As Long, ImportTotaltoImport As Long, CountTemp As Double
strSQL = "Delete * from [TEMP]"
DoCmd.RunSQL strSQL
DoCmd.TransferSpreadsheet acImport, , "TEMP2", FileLocation, True, "A1:F10000"
strSQL = "INSERT INTO [TEMP] Select * from TEMP2"
DoCmd.RunSQL strSQL
Set db = CurrentDb
Set ExistingRS = CurrentDb.OpenRecordset("tblexceptions", dbOpenDynaset)
Set NewImportRS = CurrentDb.OpenRecordset("TEMP")
SqlStr = "Delete * from [TEMP] where isnull(" & NewImportRS.Fields(1).Name & ") or " & NewImportRS.Fields(1).Name & "= ''"
DoCmd.RunSQL SqlStr
NewImportRS.MoveLast
ImportTotaltoImport = NewImportRS.RecordCount
NewImportRS.MoveFirst
ImportCount = 0
Do While Not NewImportRS.EOF
LoanNo = NewImportRS.Fields(1)
'Creates a 10 Digit Loan Number
Do While Len(LoanNo) < 10
LoanNo = "0" & LoanNo
Loop
Criterion = "[Loannumber] = '" & LoanNo & "' AND [ExceptionItem] = '" & NewImportRS.Fields(2) & "' AND [ExceptionIssue] = '" & NewImportRS.Fields(3) & "' and [Investor] = " & InvestorNo
'Looks for exisitng record of exception
ExistingRS.FindFirst Criterion
'Add record of exception that is not already present
If ExistingRS.NoMatch Then
ExistingRS.Close
Set ExistingRS = Nothing
strSQL = "INSERT INTO tblexceptions ([LoanNumber], [ExceptionItem], [ExceptionIssue], [Investor], [ExceptionType], [IssueID]) VALUES ('" & LoanNo & "', '" & NewImportRS.Fields(2) & "', '" & NewImportRS.Fields(3) & "', " & InvestorNo & ", '" & NewImportRS.Fields(5) & "','" & NewImportRS.Fields(6) & "')"
DoCmd.RunSQL strSQL
Set ExistingRS = CurrentDb.OpenRecordset("tblexceptions", dbOpenDynaset)
'ExistingRS.Requery '***********
End If
ExistingRS.FindFirst Criterion
If Not ExistingRS.NoMatch Then
strSQL = "SELECT * from tblInvestorComments where [exceptionid] = " & ExistingRS.Fields("ExceptionID")
Set CommentHistoryRS = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not IsNull(NewImportRS(3)) Then
commentString = NewImportRS.Fields(4)
commentString = Replace(commentString, "'", "-")
commentString = Replace(commentString, Chr(34), "$")
HistoryCriterion = "[Comments] = '" & commentString & "'"
CommentHistoryRS.FindFirst (HistoryCriterion)
If CommentHistoryRS.NoMatch Then
If Not IsNull(NewImportRS.Fields(4)) Then
strSQL = "INSERT INTO tblInvestorComments ([exceptionid], [Comments]) VALUES ('" & ExistingRS.Fields("ExceptionID") & "', '" & commentString & "')"
DoCmd.RunSQL (strSQL)
End If
End If
End If
End If
NewImportRS.MoveNext
ImportCount = ImportCount + 1
CountTemp = UpdateStatus(ImportCount, ImportTotaltoImport, CountTemp)
Loop
Set ExistingRS = Nothing
Set NewImportRS = Nothing
DoCmd.DeleteObject acTable, "TEMP2"
End Function