Access Import Half Way There

Private Sub Command0_Click()
	Dim rs As ADODB.Recordset
	Dim strShtName
	Dim cn As ADODB.Connection
	Dim oXL As Object, oWbXL As Object
	Dim myfile As String, mypath As String
	'
	Set cn = CurrentProject.Connection
	Set rs = New ADODB.Recordset
	'
	'The following opens "profits" table for import
	rs.Open "SELECT * FROM profits", cn, adOpenDynamic, adLockOptimistic
	'
	'Set Excel objects
	On Error Resume Next
	Set oXL = GetObject(, "Excel.Application")
	If CBool(Err.Number) Then
		Set oXL = CreateObject("Excel.Application")
		Err.Clear
	End If
	oXL.Visible = True
	'
	mypath = "n:\profit\" 'The location of the xls files
	myfile = Dir(mypath & "*.xls") 'To import ALL xls files there is a *
	Do While CBool(Len(myfile))
		Set oWbXL = oXL.Workbooks.Open(mypath & myfile)
With oWbXL
Dim strShName As String
For eng = 3 To Excel.Application.Worksheets.Count
strShtName = .sheets(eng).Name 'you may want to put a break here to see if the name is assigned correctly
For lng = 2 To 100 'This loop is to ensure all records are imported as there are never more than 100
rs.AddNew
rs.Fields("Date") = .sheets(strShtName).Range("A" & lng) 'import cell A4-100 into Field "Date"
rs.Fields("Cost") = .sheets(strShtName).Range("G" & lng) 'import cell A4-100 into Field "Cost"
rs.Fields("Jobtype") = .sheets(strShtName).Range("I" & lng) 'import cell A4-100 into Field "Jobtype"
'this imports all the relevant information for this engineer needed to complete the calculations
rs.Update 'in ADO, not necessary
Next lng 'Repeat the import untill lng reaches 100
Next eng

.Close SaveChanges:=False
End With
		myfile = Dir
	Loop
	'
	rs.Close: Set rs = Nothing
	Set oWbXL = Nothing: Set oXL = Nothing
End Sub