I'm looking for some feedback with regard to taking some data from an Excel
Workbook we use to track info on and loading it into Access AS QUICKLY AS
possible.  Once it's in Access I can do the rest, but I am sort of new at the
best method to automate the movement from Excel to Access.  I kind of know
DAO and haven't used ADO - is ADO any faster with what I'm doing below.  

I'm wanting to start a dialog and looking for resources.  Anyones help
and/or suggestions will be great.  

Public Sub btnMakeReport_Click()
On Error GoTo Error_Handling

Dim strPath As String
Dim xlsApp As Object
Dim End_Row As Long
Dim db As DAO.Database
Dim strSQL As String
Dim strCriteria1 As String
Dim strCriteria2 As String
Dim strMsg As String
Dim bWarn As Boolean
Dim intRcount As Integer
Dim intCount As Integer
Dim strWrapChar  As String
         
   'Check to see that Combo Boxes have Selections Made
   If IsNull(Me.cmbQtr.Value) = True Then
       bWarn = True
       strMsg = strMsg & "You must select a Quarter." & vbCrLf
   End If
   
   If IsNull(Me.cmbYear.Value) = True Then
       bWarn = True
       strMsg = strMsg & "You must select a Year." & vbCrLf
   End If
   
   If bWarn = True Then
       strMsg = strMsg & vbCrLf & "You must Retry"
       MsgBox strMsg, vbOKOnly, "Warning"
       Exit Sub
   End If

Set db = CurrentDb()

   'Read Combo Boxes and Set Criteria to Filter with Excel
   Select Case Me.cmbQtr
   
       Case Is = "Q1"
           strCriteria1 = ">12/31/" & Me.cmbYear & " 23:59:59"
           strCriteria2 = "<04/01/" & Me.cmbYear & " 00:00:01"
       Case Is = "Q2"
           strCriteria1 = ">03/31/" & Me.cmbYear & " 23:59:59"
           strCriteria2 = "<07/01/" & Me.cmbYear & " 00:00:01"
       Case Is = "Q3"
           strCriteria1 = ">06/30/" & Me.cmbYear & " 23:59:59"
           strCriteria2 = "<010/01/" & Me.cmbYear & " 00:00:01"
       Case Is = "Q4"
           strCriteria1 = ">09/30/" & Me.cmbYear & " 23:59:59"
           strCriteria2 = "<01/01/" & Me.cmbYear + 1 & " 00:00:01"
           
   End Select
   
   'Opens Windows Dialog Module written by Ken Getz
   strPath = GetOpenFileExcel
   
   'If User Canels Quit Sub
   If IsNull(strPath) = True Or strPath = "" Then
   Exit Sub
   Else

   
Set xlsApp = CreateObject("Excel.Application")

xlsApp.Visible = False

   'Open Workbook as Read-Only
   xlsApp.WorkBooks.Open strPath, UpdateLinks:=0, ReadOnly:=True
   xlsApp.Sheets("Master BOM Sheet").Select
   'Turn off filter if on.
   If xlsApp.Sheets("Master BOM Sheet").FilterMode = True Then
       xlsApp.ActiveSheet.ShowAllData
   End If
   'Set my filter based on Quarter requested.
   xlsApp.Selection.AutoFilter Field:=3, Criteria1:=strCriteria1,
Operator:=1, Criteria2:=strCriteria2
   End_Row = xlsApp.Cells(xlsApp.Rows.Count, 1).End(-4162).Row
   xlsApp.Range(xlsApp.Cells(26, 1), xlsApp.Cells(End_Row,
38)).SpecialCells(12).Select
   xlsApp.Selection.Copy
   xlsApp.WorkBooks.Add
   xlsApp.Selection.PasteSpecial Paste:=-4163
   xlsApp.Application.CutCopyMode = False
   'Replace Characters that will cause the APPEND Query to fail
   On Error Resume Next
   xlsApp.Selection.Replace What:="""", Replacement:="''", LookAt:=2,
SearchOrder:=1
   xlsApp.Selection.Replace What:="#N/A", Replacement:="NA", LookAt:=2,
SearchOrder:=1
   On Error GoTo Error_Handling
   End_Row = xlsApp.Cells(xlsApp.Rows.Count, 1).End(-4162).Row
   intRcount = 2
   
   'Clear any old data
   db.Execute "DELETE * FROM tblDMLifeCycle;"
   
   Do
       'Insert data into the table
       strSQL = ""
       strSQL = strSQL & "INSERT INTO tblDMLifeCycle"
       strSQL = strSQL & " VALUES ("

           For intCount = 1 To 38
               Select Case intCount
                   Case Is = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
15, 16, 17, 18, 19, 24, 29, 31, 37
                       strWrapChar = """"
                       strSQL = strSQL & strWrapChar &
xlsApp.Cells(intRcount, intCount) & strWrapChar
                   Case Else
                       strWrapChar = ""
                       If Trim(xlsApp.Cells(intRcount, intCount)) = "" Then
                           strSQL = strSQL & strWrapChar & 0 & strWrapChar
                       Else
                           strSQL = strSQL & strWrapChar &
xlsApp.Cells(intRcount, intCount) & strWrapChar
                       End If
               End Select
                   
               If intCount <> 38 Then
                   strSQL = strSQL & ","
               Else
                   strSQL = strSQL & ")"
               End If
           Next
           db.Execute strSQL
           intRcount = intRcount + 1
   Loop Until intRcount > End_Row
   
   Do While xlsApp.WorkBooks.Count > 0
       xlsApp.WorkBooks(1).Close False 'close without saving
   Loop

xlsApp.Quit
Set xlsApp = Nothing

End If

Error_Handling:

MsgBox Err.Description

Exit Sub

End Sub