Import Multiple Excel Spreadsheet into Access

Option Compare Database
Option Explicit
'***********************************************************
'Macro Loops through the specified directory (strPath)
'and imports ALL Excel files as linked tables in the Access
'Database.
'***********************************************************
Sub Import_To_Excel()
'Directory Path
Const strPath As String = "FULL PATH TO the folder containing your files"
'Filename
Dim strFile As String
'File Array
Dim strFileList() As String
'File Number
Dim intFile As Integer
DoCmd.SetWarnings False
'Loop through the folder & build file list
strFile = Dir(strPath & "*.xls")
Do While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Loop
'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
For intFile = 1 To UBound(strFileList)
'replace TABLE NAME and RANGE to fit
DoCmd.TransferSpreadsheet acImport, , _
"TABLE NAME", strPath & strFileList(intFile), True, "RANGE"
Next
DoCmd.SetWarnings True
MsgBox UBound(strFileList) & " Files were Imported"
End Sub