Link to home
Start Free TrialLog in
Avatar of Ross
RossFlag for United Kingdom of Great Britain and Northern Ireland

asked on

MS Access vba recordset not updating, but no errors

Hi all

I urgently need some help and hope you can assist.

The following code is designed to import from a temporary table with a primary table, however it only partially works and I cannot see why the remainder doesn't work. I need help!

in the recordset (rsTEMP) if rsTEMP![Exception Requested] = True then the code works perfectly, and the record is updated as I want. However, if rsTEMP![Can Close] = True And rsTEMP![Exception Requested] = False vba runs through the code (I can step through line by line and watch it run each line) but the recordset never updates! It gives no errors or warnings (I have turned off the error traps).

It executes the rsFailures.update command, but that doesn't result in any changes, even though I can see the correct settings in the stepthrough.

Please help - I'm pulling my hair out!

Regards

Ross


Do While Not rsTEMP.EOF
    
    ' Merge the temporary tables data with our failures data (investigated details table)
    rsInvestigatedDetails.AddNew
    rsInvestigatedDetails("Call").Value = rsTEMP![Call]
    Debug.Print "Subimporting call: " & rsTEMP![Call]
    rsInvestigatedDetails("WhenAdded").Value = Now
    rsInvestigatedDetails("WhoAdded").Value = "SysImport"
    rsInvestigatedDetails("Note").Value = rsTEMP![SubContractor Response]
    rsInvestigatedDetails.Update
    
    ' Check if call can be closed
    If rsTEMP![Can Close] = True And rsTEMP![Exception Requested] = False Then
        rsFailures.FindFirst ("Call" = rsTEMP![Call])
        Debug.Print rsTEMP![Call] & " requested closure"
        rsFailures.Edit
        ' Close the call in the DB
        rsFailures("IsClosed").Value = True
        rsFailures("Investigated Reasons").Value = Nz(DLookup("ReasonID", "tblReasons", "Reason = '" & rsTEMP![Reason] & "'"), 311)
        rsFailures.Update

    ElseIf rsTEMP![Exception Requested] = True Then
        rsFailures.FindFirst ("Call" = rsTEMP![Call])
        Debug.Print rsTEMP![Call] & " requested exception"
        rsFailures.Edit
        ' Change the investigator to ICMT so we have visibility of the incident
        rsFailures("Investigator").Value = 21
        ' Change the Investigated Reason to 30 (Exception) so we can see they're requesting an exception
        rsFailures("Investigated Reasons").Value = 300
        rsFailures.Update
    End If
    
    rsTEMP.MoveNext
Loop

rsTEMP.Close

Open in new window

Avatar of mbizup
mbizup
Flag of Kazakhstan image

Give this revision a try... using a single rs!update (I think the placement of your first update may be preventing the others from ocurring):

Do While Not rsTEMP.EOF
    
    ' Merge the temporary tables data with our failures data (investigated details table)
    rsInvestigatedDetails.AddNew
    rsInvestigatedDetails("Call").Value = rsTEMP![Call]
    Debug.Print "Subimporting call: " & rsTEMP![Call]
    rsInvestigatedDetails("WhenAdded").Value = Now
    rsInvestigatedDetails("WhoAdded").Value = "SysImport"
    rsInvestigatedDetails("Note").Value = rsTEMP![SubContractor Response]
        
    ' Check if call can be closed
    If rsTEMP![Can Close] = True And rsTEMP![Exception Requested] = False Then
        rsFailures.FindFirst ("Call" = rsTEMP![Call])
        Debug.Print rsTEMP![Call] & " requested closure"
        rsFailures.Edit
        ' Close the call in the DB
        rsFailures("IsClosed").Value = True
        rsFailures("Investigated Reasons").Value = Nz(DLookup("ReasonID", "tblReasons", "Reason = '" & rsTEMP![Reason] & "'"), 311)

    ElseIf rsTEMP![Exception Requested] = True Then
        rsFailures.FindFirst ("Call" = rsTEMP![Call])
        Debug.Print rsTEMP![Call] & " requested exception"
        rsFailures.Edit
        ' Change the investigator to ICMT so we have visibility of the incident
        rsFailures("Investigator").Value = 21
        ' Change the Investigated Reason to 30 (Exception) so we can see they're requesting an exception
        rsFailures("Investigated Reasons").Value = 300
    End If
    rsInvestigatedDetails.Update

    rsTEMP.MoveNext
Loop

rsTEMP.Close

Open in new window

Avatar of Ross

ASKER

Thank you for the prompt reply, but unfortunately that has not helped :(
Right... ignore my last post:

---> rsFailures.FindFirst ("Call" = rsTEMP![Call])

Change your criteria to this:

rsFailures.FindFirst ("Call = " &  rsTEMP![Call])

Open in new window

Or if Call is Text:

rsFailures.FindFirst ("Call = '" &  rsTEMP![Call] & "'")

Open in new window

You are assuming that the records in your temp table are all in rsFailures.  Is that a valid assumption.

Whenever I use the findfirst method, I ALWAYS test to make sure the record was found.

Rsfailures.findfirst "[call]=" & rs temp![call]
If rsfailures.nomatch then
    Msgbox "not found"
Else if ...
Avatar of Ross

ASKER

Thank you both. Mbizup - nope, even with that code it still doesn't work.

Fyed - yes, these records are always going to be found in rsFailures. They are exported from that table a few days prior (it's a long winded story, but they are exported to excel and emailed for a supplier to complete some fields, and this action is supposed to automatically import their replies).

Thanks for your continued assistance in tracking this down!
As an aside...

>>> rsFailures.FindFirst ("Call" = rsTEMP![Call])

The reason that your original criteria does not work is that is is looking for cases where rsTemp!Call is equal to "Call" (the literal string).

Did you make the change I suggested in both places in your code (both in the If and in the EseIf)?

If so you may have something like stray spaces in your data --- Use fyed's 'NoMatch' check.  It is a good practice which will definitively let you know if a matching record was found.

Also try changing your criteria to trim any spaces:

rsFailures.FindFirst "Trim('' & Call) = '" &  Trim( "" & rsTEMP![Call])  & "'"

Open in new window

Hi,

Maybe we need to go back to basics.

Is your data in an MS Access database?
Do you have a primary key in the table?

Regards,

Bill
<<
but they are exported to excel and emailed for a supplier to complete some fields,
>>

Another potential issue is that character codes for some things like line breaks are different in Excel than they are in Access, and may cause your criteria to fail if the supplier is entering data in Excel.  Again, that would be trapped by the NoMatch suggestion made earlier.
Add an error handler.  It's possible that you are encountring an error (like a non-updateable recordset) and it's being ignored because error handling is turned off.

Jim.
It would also be helpful if you posted the entire routine.  Without things like the open for rsFailures and rsInvestigatedDetails, it's difficult to see what might be going on.

Your .Addnew/.Edit/.Update structure looks fine.

Jim.
Hi,

Just a thought - if the DB is SQL rather than MS Acccess the code needs to be modified with dbSeeChanges or it will give these exact symptoms.

Regards,

Bill
Avatar of Ross

ASKER

Thank you all for your continued assistance. I will post the entire routine but please take it easy, I'm still not hugely experienced.

Error handling is not enabled and if I intentionally create an error it does show me.

I am developing in VBA for MS Access yes.

the entire routine as it is at the moment:

Sub Import_From_Excel()

On Error GoTo Err_Import_From_Excel

  '  This subprocedure loops determines whether any Excel files exist in the folder stored
  '  in the strcPath constant; if there are, this subprocedure imports the data in those
  '  Excel files into a temp table for subbies.
  
  '  Store the directory Path:
  Const strcPath As String = _
    "O:\Mobile Services\Servicecenter\IcMT\ActionLog\SubImports"
  
  '  Store the name of the table into which
  '  the data will be imported
  Const strcTableName As String = "tblSubTempImport"
  
  Dim strPath As String
  Dim strFile As String
  Dim strFileList() As String
  Dim intFile As Integer
  Dim strFullPath As String
  
  '  See if path constant ends in a backslash:
  If Right(strcPath, 1) = "\" Then
    strPath = strcPath
  Else
    strPath = strcPath & "\"
  End If
  
  '  Loop through the Excel files in the folder
  '  (if any) and build file list:
  strFile = Dir(strPath & "*.xls")
  While strFile <> ""
    intFile = intFile + 1
    ReDim Preserve strFileList(1 To intFile)
    strFileList(intFile) = strFile
    strFile = Dir()
  Wend
  
  '  See if any files were found:
  If intFile = 0 Then
  
'    MsgBox strcPath & vbNewLine & vbNewLine _
'      & "The above directory contains no Excel " _
'      & "files.", _
'      vbExclamation + vbOKOnly, "Program Finished"
      
    GoTo Exit_Import_From_Excel
    
  End If
    ' There's file(s) to process - lets do something...
    
    DoCmd.OpenForm "frmImportSubContractorFailures"
  
  '  Cycle through the list of files and import into
  '  Access, creating a new table if necessary:
  For intFile = 1 To UBound(strFileList)
    
    strFullPath = strPath & strFileList(intFile)
    
    CheckTableExists = CurrentDb.TableDefs(strcTableName)
    If Err.Number = 0 Then
        Set CheckTableExists = Nothing
        DoCmd.RunSQL "DROP TABLE " & strcTableName
        End If
    
    
    DoCmd.TransferSpreadsheet acImport, _
      acSpreadsheetTypeExcel97, strcTableName, _
      strFullPath, True
    
  Next
  
  ' Delete any files in this folder after performing an import
  Kill (strPath & "*.*")
  
Dim db As DAO.Database
Dim rsTEMP As DAO.Recordset, rsInvestigatedDetails As DAO.Recordset, rsFailures As DAO.Recordset
Dim strSQLTEMP As String, strsqlInvestigatedDetails As String, strsqlMainFailures As String

strSQLTEMP = "SELECT tblSubTempImport.* FROM tblSubTempImport;"
strsqlInvestigatedDetails = "SELECT tblInvestigatedDetails.*, tblFailures.IsClosed "
strsqlInvestigatedDetails = strsqlInvestigatedDetails & "FROM tblInvestigatedDetails INNER JOIN tblFailures ON tblInvestigatedDetails.Call = tblFailures.Call;"
strsqlFailures = "SELECT tblFailures.* FROM tblSubTempImport INNER JOIN tblFailures ON tblSubTempImport.Call = tblFailures.Call;"

Set db = CurrentDb
Set rsTEMP = db.OpenRecordset(strSQLTEMP)
Set rsInvestigatedDetails = db.OpenRecordset(strsqlInvestigatedDetails)
Set rsFailures = db.OpenRecordset(strsqlFailures)

' Cycle through the temporary table, adding entries into the tblInvestigatedDetails table where needed
rsTEMP.MoveFirst

Do While Not rsTEMP.EOF

    ' Merge the temporary tables data with our failures data (investigated details table)
    rsInvestigatedDetails.AddNew
    rsInvestigatedDetails("Call").Value = rsTEMP![Call]
    Debug.Print "Subimporting call: " & rsTEMP![Call]
    rsInvestigatedDetails("WhenAdded").Value = Now
    rsInvestigatedDetails("WhoAdded").Value = "SysImport"
    rsInvestigatedDetails("Note").Value = rsTEMP![SubContractor Response]
    rsInvestigatedDetails.Update

    ' Check if call can be closed
    If rsTEMP![Can Close] = True And rsTEMP![Exception Requested] = False Then
        rsFailures.FindFirst ("Call" = rsTEMP![Call])
        Debug.Print rsTEMP![Call] & " requested closure"
        rsFailures.Edit
        ' Close the call in the DB
        rsFailures("IsClosed").Value = True
        rsFailures("Investigated Reasons").Value = Nz(DLookup("ReasonID", "tblReasons", "Reason = '" & rsTEMP![Reason] & "'"), 311)
        rsFailures.Update

    ElseIf rsTEMP![Exception Requested] = True Then
        rsFailures.FindFirst ("Call" = rsTEMP![Call])
        Debug.Print rsTEMP![Call] & " requested exception"
        rsFailures.Edit
        ' Change the investigator to ICMT so we have visibility of the incident
        rsFailures("Investigator").Value = 21
        ' Change the Investigated Reason to 30 (Exception) so we can see they're requesting an exception
        rsFailures("Investigated Reasons").Value = 300
        rsFailures.Update
    End If

    rsTEMP.MoveNext
Loop

rsTEMP.Close
rsInvestigatedDetails.Close
db.Close

Set rsTEMP = Nothing
Set rsInvestigatedDetails = Nothing
Set db = Nothing

'  MsgBox UBound(strFileList) & " file(s) were imported", _
 '   vbOKOnly + vbInformation, "Program Finished"
    
Exit_Import_From_Excel:
  Exit Sub
  
Err_Import_From_Excel:
    MsgBox Err.Number & ", " & Err.Description, , "Error in Sub Import_From_Excel"
    Resume Exit_Import_From_Excel
  
End Sub

Open in new window


Thank you all for the generous assistance so far.
Try this (it changes the criteria as I suggested and adds the No Match check as fyed suggeested) - and let us know if the 'no match' message boxes pop up.

Sub Import_From_Excel()

On Error GoTo Err_Import_From_Excel

  '  This subprocedure loops determines whether any Excel files exist in the folder stored
  '  in the strcPath constant; if there are, this subprocedure imports the data in those
  '  Excel files into a temp table for subbies.
  
  '  Store the directory Path:
  Const strcPath As String = _
    "O:\Mobile Services\Servicecenter\IcMT\ActionLog\SubImports"
  
  '  Store the name of the table into which
  '  the data will be imported
  Const strcTableName As String = "tblSubTempImport"
  
  Dim strPath As String
  Dim strFile As String
  Dim strFileList() As String
  Dim intFile As Integer
  Dim strFullPath As String
  
  '  See if path constant ends in a backslash:
  If Right(strcPath, 1) = "\" Then
    strPath = strcPath
  Else
    strPath = strcPath & "\"
  End If
  
  '  Loop through the Excel files in the folder
  '  (if any) and build file list:
  strFile = Dir(strPath & "*.xls")
  While strFile <> ""
    intFile = intFile + 1
    ReDim Preserve strFileList(1 To intFile)
    strFileList(intFile) = strFile
    strFile = Dir()
  Wend
  
  '  See if any files were found:
  If intFile = 0 Then
  
'    MsgBox strcPath & vbNewLine & vbNewLine _
'      & "The above directory contains no Excel " _
'      & "files.", _
'      vbExclamation + vbOKOnly, "Program Finished"
      
    GoTo Exit_Import_From_Excel
    
  End If
    ' There's file(s) to process - lets do something...
    
    DoCmd.OpenForm "frmImportSubContractorFailures"
  
  '  Cycle through the list of files and import into
  '  Access, creating a new table if necessary:
  For intFile = 1 To UBound(strFileList)
    
    strFullPath = strPath & strFileList(intFile)
    
    CheckTableExists = CurrentDb.TableDefs(strcTableName)
    If Err.Number = 0 Then
        Set CheckTableExists = Nothing
        DoCmd.RunSQL "DROP TABLE " & strcTableName
        End If
    
    
    DoCmd.TransferSpreadsheet acImport, _
      acSpreadsheetTypeExcel97, strcTableName, _
      strFullPath, True
    
  Next
  
  ' Delete any files in this folder after performing an import
  Kill (strPath & "*.*")
  
Dim db As DAO.Database
Dim rsTEMP As DAO.Recordset, rsInvestigatedDetails As DAO.Recordset, rsFailures As DAO.Recordset
Dim strSQLTEMP As String, strsqlInvestigatedDetails As String, strsqlMainFailures As String

strSQLTEMP = "SELECT tblSubTempImport.* FROM tblSubTempImport;"
strsqlInvestigatedDetails = "SELECT tblInvestigatedDetails.*, tblFailures.IsClosed "
strsqlInvestigatedDetails = strsqlInvestigatedDetails & "FROM tblInvestigatedDetails INNER JOIN tblFailures ON tblInvestigatedDetails.Call = tblFailures.Call;"
strsqlFailures = "SELECT tblFailures.* FROM tblSubTempImport INNER JOIN tblFailures ON tblSubTempImport.Call = tblFailures.Call;"

Set db = CurrentDb
Set rsTEMP = db.OpenRecordset(strSQLTEMP)
Set rsInvestigatedDetails = db.OpenRecordset(strsqlInvestigatedDetails)
Set rsFailures = db.OpenRecordset(strsqlFailures)

' Cycle through the temporary table, adding entries into the tblInvestigatedDetails table where needed
rsTEMP.MoveFirst

Do While Not rsTEMP.EOF

    ' Merge the temporary tables data with our failures data (investigated details table)
    rsInvestigatedDetails.AddNew
    rsInvestigatedDetails("Call").Value = rsTEMP![Call]
    Debug.Print "Subimporting call: " & rsTEMP![Call]
    rsInvestigatedDetails("WhenAdded").Value = Now
    rsInvestigatedDetails("WhoAdded").Value = "SysImport"
    rsInvestigatedDetails("Note").Value = rsTEMP![SubContractor Response]
    rsInvestigatedDetails.Update

    ' Check if call can be closed
    If rsTEMP![Can Close] = True And rsTEMP![Exception Requested] = False Then
        rsFailures.FindFirst  "Call = '" & rsTEMP![Call] & "'"
        if rsFailures.Nomatch = true then 
             msgbox "No match"
        else
        Debug.Print rsTEMP![Call] & " requested closure"
        rsFailures.Edit
        ' Close the call in the DB
        rsFailures("IsClosed").Value = True
        rsFailures("Investigated Reasons").Value = Nz(DLookup("ReasonID", "tblReasons", "Reason = '" & rsTEMP![Reason] & "'"), 311)
        rsFailures.Update
       end if
    ElseIf rsTEMP![Exception Requested] = True Then
        rsFailures.FindFirst  "Call = '" & rsTEMP![Call] & "'"
        if rsFailures.Nomatch = true then 
             msgbox "No match"
        else
        Debug.Print rsTEMP![Call] & " requested exception"
        rsFailures.Edit
        ' Change the investigator to ICMT so we have visibility of the incident
        rsFailures("Investigator").Value = 21
        ' Change the Investigated Reason to 30 (Exception) so we can see they're requesting an exception
        rsFailures("Investigated Reasons").Value = 300
        rsFailures.Update
    End If
   end if

    rsTEMP.MoveNext
Loop

rsTEMP.Close
rsInvestigatedDetails.Close
db.Close

Set rsTEMP = Nothing
Set rsInvestigatedDetails = Nothing
Set db = Nothing

'  MsgBox UBound(strFileList) & " file(s) were imported", _
 '   vbOKOnly + vbInformation, "Program Finished"
    
Exit_Import_From_Excel:
  Exit Sub
  
Err_Import_From_Excel:
    MsgBox Err.Number & ", " & Err.Description, , "Error in Sub Import_From_Excel"
    Resume Exit_Import_From_Excel
  
End Sub

Open in new window

Avatar of Ross

ASKER

Okay - I replaced the entire routine with the code you adjusted above, and we have the same "problem" - no errors (and additionally nothing pops up as per the adjusted code) and still no updates in the actual table/recordset.

Any more thoughts?
SOLUTION
Avatar of mbizup
mbizup
Flag of Kazakhstan image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Are you certain the data types of the fields you are importing from Excel match those in your tblFailures?

In my opinion, one of the biggest problems with Access is its ability to import Excel files, because MS has provided no Import Specification that allows you to define the proper structure of those imported tables.

I generally use a staging table to import all my Excel data into, which is composed entirely of text fields.  I import the data from Excel into that table, then run checks to make sure the data in that table is of the appropriate data types.  For those that don't  , and then run a query that moves the data from the staging table into the destination table.  This query would explicitly change the data types.
Avatar of Ross

ASKER

Guys thank you ALL for your continued assistance with this - it's finally now working after I have replaced my code with yours. I can't be specific and say what has made it work, but the routines you have provided me with have done something for sure - everything is now working exactly as I had hoped and I'm very grateful! I'll try and split up the points as best as I can!