Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

importerrors table locking problem

Status
Not open for further replies.

ghalewood

Programmer
Nov 13, 2001
42
EU
Hi everyone,

I am running the following code to import multiple files into a table. I am getting an error, which I am expecting, but for some reason the Importerrors table is being locked and therefore the delete portion of the code is not working. The only way I can manually delete the tables is to close the project and reopen it. Can anyone see where I am going wrong with the code.

I am running Access97.

This is the code
Code:
Sub import_sales()

  Dim myDB                 As Database
  Dim rsParameters         As Recordset    ' Prameters table
  Dim rsAddress            As Recordset    ' store Store details table
  Dim rsNotpolled          As Recordset    ' Not polled table
  Dim intstoreno            As Integer      ' store number
  Dim strMydate            As String
  Dim strStore             As String
  Dim strData              As String
  Dim strImporterrors      As String
  Dim strPolllocation      As String
  Dim strError             As String
  Dim dteNopoll            As Date
  Dim dteToprocess         As Date

  Set myDB = CurrentDb()
  
  Set rsParameters = myDB.OpenRecordset("SELECT * FROM [parameters]")
  rsParameters.Edit
      rsParameters!date_last_sales = Format(Date, "dd/mm/yyyy")
  rsParameters.Update
  
  On Error GoTo ErrorHandler      ' Enable error-handling routine.

  dteToprocess = InputBox("Please Enter Date to Process", "Process Date", Format(DateAdd("d", -1, Date), "dd/mm/yyyy"))
   
  'import Catalist file using todays date. Perameter DB "parameters" is used for path to file
  strMydate = Format(dteToprocess, "YYMMDD")
  dteNopoll = Format(dteToprocess, "dd/mm/yyyy")
  Set rsParameters = myDB.OpenRecordset("parameters")
  rsParameters.MoveFirst
  strPolllocation = rsParameters!Sales_location

  If strStoretoprocess = "all" Then
     Set rsAddress = myDB.OpenRecordset("SELECT * FROM [store_Details] _ where [do_not_poll] = FALSE ORDER by [store]")
  Else
     Set rsAddress = myDB.OpenRecordset("SELECT * FROM [store_Details] _ where [do_not_poll] = FALSE and [store] = """ & strStoretoprocess & """")
  End If
  If rsAddress.RecordCount <> 0 Then
     rsAddress.MoveFirst

     Do Until rsAddress.EOF
        strStore = rsAddress!STORE
        intstoreno = rsAddress!store_store_no
        strError = &quot;Transfer&quot;                                       ' populate message for error reporting
        strData = strPolllocation & rsAddress!Poll_location & &quot;\&quot; & &quot;DE&quot; & strMydate & &quot;.CSV&quot;
        DoCmd.TransferText , &quot;sales_import_specification&quot;, &quot;sales_data&quot;, strData
        strImporterrors = &quot;DE&quot; & strMydate & &quot;_ImportErrors&quot;
        strError = &quot;Delete&quot;
        
        DoCmd.Close acTable, &quot;&quot;&quot; & strimporterrors & &quot;&quot;&quot;, acSaveYes ' Close Table
        DoCmd.DeleteObject acTable, strImporterrors        ' Delete any tables created due to import errors

        rsAddress.MoveNext
     Loop

     Set rsNotpolled = myDB.OpenRecordset(&quot;select * from [not_polled]&quot;)

     If rsNotpolled.RecordCount <> 0 Then
        rsNotpolled.MoveLast

        If MsgBox(&quot;There were &quot; & rsNotpolled.RecordCount & &quot; stores not polled. See Not Polled report for details&quot;, vbOKOnly, &quot;Stores Not Polled&quot;) = vbOK Then
        End If

     End If
  End If
endofproc:
  
  Set myDB = Nothing
  Set rsParameters = Nothing
  Set rsAddress = Nothing
  Set rsNotpolled = Nothing
  Exit Sub

ErrorHandler:
  ' Error-handling routine.

    Select Case Err.Number
      ' Evaluate error number.
      Case 3044             ' &quot;Directory Does not Exist&quot; error. i.e. not polled
         If strError = &quot;transfer&quot; Then
         
            If MsgBox(&quot;Directory &quot; & strData & &quot; Does not Exist&quot;, vbOKOnly, &quot;Invalid Directory&quot;) = vbOK Then
            End If

            Set rsNotpolled = myDB.OpenRecordset(&quot;not_polled&quot;)
            rsNotpolled.AddNew
            rsNotpolled!Store_Number = intstoreno
            rsNotpolled!Store_Name = strStore
            rsNotpolled!date_not_polled = dteNopoll
            rsNotpolled!type = &quot;Not Polled&quot;
            rsNotpolled!reason = &quot;Directory does not exist&quot;
            rsNotpolled.Update
      
         End If
      
      Case 3011
      
        ' file not in directory
         If strError = &quot;transfer&quot; Then
            Set rsNotpolled = myDB.OpenRecordset(&quot;not_polled&quot;)
            rsNotpolled.AddNew
               rsNotpolled!Store_Number = intstoreno
               rsNotpolled!Store_Name = strStore
               rsNotpolled!date_not_polled = dteNopoll
               rsNotpolled!type = &quot;Not Polled&quot;
               rsNotpolled!reason = &quot;No file in Directory&quot;
            rsNotpolled.Update
         End If
      
      Case 13
        
        GoTo endofproc
      
      Case 7874
        
        ' attempting to delete table not in existance - ok
      
      Case 3211
        
        ' cannot delete table
      
      Case Else

        If MsgBox(&quot;Error occurred &quot; & Err.Number & &quot; for store &quot; & strData & &quot; Please note details for investigation&quot;, vbOKOnly, &quot;Error&quot;) = vbOK Then
        End If

     End Select

  Resume Next
  ' Resume execution at line after the one that caused the error.


End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top