Code to read Excel cells into Access table?

Sub Link_To_Excel()
     'WillR - [URL="http://www.willr.info"]www.willr.info[/URL] (December 2004)
     'Macro Loops through the specified directory (strPath)
     'and links ALL Excel files as linked tables in the Access
     'Database.
 
    Const strPath As String = "[URL="file://\\wat-be8k230\DICE"]serverpath[/URL]\New Files for upload\" 'Directory Path
    Dim strFile As String 'Filename
    Dim strFileList() As String 'File Array
    Dim intFile As Integer 'File Number
     'Dim intLine As Double 'Number of Lines
 
     'Loop through the folder & build file list
    strFile = Dir(strPath & "*.xlsx")
    While strFile <> ""
         'add files to the list
        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 "No files found"
        Exit Sub
    End If
 
     'cycle through the list of files & import to Access
     'appending to tables called DealerLists and DealerContacts
    For intFile = 1 To UBound(strFileList)
 
        'Read the number of lines in the file
        Dim xl As Excel.Application
        Dim xlsht As Excel.worksheet
        Dim xlWrkBk As Excel.Workbook
        Dim [B]xlCell[/B] As Double
 
        Set xl = CreateObject("Excel.Application")
        Set xlWrkBk = GetObject(strPath & strFileList(intFile))
        Set xlsht = xlWrkBk.Worksheets("Counters")
        Set xlCell = xlsht.cells(2, "A")
 
        DoCmd.TransferSpreadsheet acImport, , _
        "DealerLists", strPath & strFileList(intFile), True, "parts!A1:E"[B] & xlCell[/B]
        DoCmd.TransferSpreadsheet acImport, , _
        "DealerContacts", strPath & strFileList(intFile), True, "contact!A1:F2"
 
         'Check out the TransferSpreadsheet options in the Access
         'Visual Basic Help file for a full description & list of optional settings
        Set xl = Nothing
        Set xlWrkBk = Nothing
        Set xlsht = Nothing
        Set xlCell = Nothing
    Next
    MsgBox UBound(strFileList) & " Files were Imported"
End Sub