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
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 = "Transfer" ' populate message for error reporting
strData = strPolllocation & rsAddress!Poll_location & "\" & "DE" & strMydate & ".CSV"
DoCmd.TransferText , "sales_import_specification", "sales_data", strData
strImporterrors = "DE" & strMydate & "_ImportErrors"
strError = "Delete"
DoCmd.Close acTable, """ & strimporterrors & """, acSaveYes ' Close Table
DoCmd.DeleteObject acTable, strImporterrors ' Delete any tables created due to import errors
rsAddress.MoveNext
Loop
Set rsNotpolled = myDB.OpenRecordset("select * from [not_polled]")
If rsNotpolled.RecordCount <> 0 Then
rsNotpolled.MoveLast
If MsgBox("There were " & rsNotpolled.RecordCount & " stores not polled. See Not Polled report for details", vbOKOnly, "Stores Not Polled") = 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 ' "Directory Does not Exist" error. i.e. not polled
If strError = "transfer" Then
If MsgBox("Directory " & strData & " Does not Exist", vbOKOnly, "Invalid Directory") = vbOK Then
End If
Set rsNotpolled = myDB.OpenRecordset("not_polled")
rsNotpolled.AddNew
rsNotpolled!Store_Number = intstoreno
rsNotpolled!Store_Name = strStore
rsNotpolled!date_not_polled = dteNopoll
rsNotpolled!type = "Not Polled"
rsNotpolled!reason = "Directory does not exist"
rsNotpolled.Update
End If
Case 3011
' file not in directory
If strError = "transfer" Then
Set rsNotpolled = myDB.OpenRecordset("not_polled")
rsNotpolled.AddNew
rsNotpolled!Store_Number = intstoreno
rsNotpolled!Store_Name = strStore
rsNotpolled!date_not_polled = dteNopoll
rsNotpolled!type = "Not Polled"
rsNotpolled!reason = "No file in Directory"
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("Error occurred " & Err.Number & " for store " & strData & " Please note details for investigation", vbOKOnly, "Error") = vbOK Then
End If
End Select
Resume Next
' Resume execution at line after the one that caused the error.
End Sub