I am trying to populate an Access table with Excel data. I am using Office
2000.

The following code, running in my excel workbook, works off and on but is
not consistent. Any thoughts would be greatly appreaciated.

Dim db As Database, rs As Recordset, RFound As Boolean, JVar As Variant,
DVar As Variant, MyFile, MyDate As Date


Application.DisplayAlerts = False
Application.ScreenUpdating = False

On Error Resume Next

Set db =
OpenDatabase("\\GEORGE\Public\Databases\Production \Secure\Production.mdb")
' open the database
Set rs = db.OpenRecordset("ProductionbySC", dbOpenTable)
' get all records in a table

JVar = Range("B3").Value
DVar = Range("B2").Value


If JVar = "" Then
MsgBox "There is no Julian Date, Please enter the Julian Date", vbOKOnly
Cancel = True
Exit Sub
End If

If DVar = "" Then
MsgBox "There is no Date, Please enter the Date", vbOKOnly
Cancel = True
Exit Sub
End If


' Clear out Detail Page
Sheets("Details").Select
Range("A2:M2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents


' Copy to Detail Sheet
Sheets("Main").Select
Range("C6:O33").Select
Selection.Copy
Sheets("Details").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False

Range("A2").Select

i = 0

Do

i = i + 1

If ActiveCell.Value = "" Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If

Loop Until i = 29


Range("A1").Select

ActiveWorkbook.Names("Detail").Delete
Range("A1:M1").Select
Range(Selection, Selection.End(xlDown)).Name = "Detail"

MyFile = ActiveWorkbook.FullName

MyDate = Sheets("Main").Range("B2")

Sql = "DELETE * FROM ProductionbySC WHERE Date = " & MyDate '''''''
Doesn't Work
DoCmd.RunSQL (Sql) ''''''' Doesn't Work

DoCmd.TransferSpreadsheet acImport, 5, "ProductionbySC", MyFile, True,
"Detail" ''''''' Doesn't Work all the time

rs.Close
Set rs = Nothing
db.Close