REPOST - Moving Data From Excel into Access

[Guest]

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

 

[Tim Williams]

Steven,

It seems like you have a reasonable procedure which (I assume) works fine
for what you need. It wouldn't be a big deal to switch it to ADO since you
seem to have most of the DAO code separated into other procedures. However,
since no-one else is likely to be in a position to really test it I'm not
sure you're going to get a lot of response to your questions.

Are you posting because you feel it should be faster? Can you provide any
performance figures? I would not expect a huge difference in performance
using ADO: although it is newer than DAO I've often seen the opinion that
DAO is perhaps "better" when working with Access.

Regards,

Tim.

 

[Guest]

Tim,

Thanks for the response, and you make a good point. I'll just do some
testing myself to see if the procedure speeds up any. I just haven't learned
any ADO yet and am wondering how soon I should dive into it.

I guess I was just looking for anyones help or guideance on taking data from
Excel and putting it into Access. Is using an INSERT INTO SQL statement the
most effecient?

Thanks again for the info...

 

[Tim Williams]

Steven,

Most authors seem to recommend the direct use of SQL "update" or "insert"
statements in preference to the approach promoted by MS, which is to open a
dynamic recordset and use the recordset's update/insert methods and finally
batch-update the database from the recordset.

For maximum efficiency update statements can be concatenated with ";" and
batched, but that makes it more difficult to respond to any exceptions
raised during the update process.

Tim

 

[Guest]

Tim,

I might like to try the ";" how would the syntax go? I fiddled with it, but
got the error that characters were found after end of SQL statement.

INSERT INTO tblDMLifeCycle VALUES ("Standard","38626","38656"); INSERT INTO
tblDMLifeCycle VALUES ("Standard","38626","38656");

 

[Tim Williams]

I think you need to avoid a trailing ";"

Tim