Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
REPOST - Moving Data From Excel into Access
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
REPOST - Moving Data From Excel into Access
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. "Steven M. Britton" wrote in message ... 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
REPOST - Moving Data From Excel into Access
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" wrote: 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. "Steven M. Britton" wrote in message ... 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
REPOST - Moving Data From Excel into Access
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 -- Tim Williams Palo Alto, CA "Steven M. Britton" wrote in message ... 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" wrote: 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. "Steven M. Britton" wrote in message ... 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
REPOST - Moving Data From Excel into Access
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"); "Steven M. Britton" wrote: 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" wrote: 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. "Steven M. Britton" wrote in message ... 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
REPOST - Moving Data From Excel into Access
I think you need to avoid a trailing ";"
Tim -- Tim Williams Palo Alto, CA "Steven M. Britton" wrote in message ... 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"); "Steven M. Britton" wrote: 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" wrote: 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. "Steven M. Britton" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Moving Data From Excel into Access | Excel Programming | |||
moving an Access form to Excel | Excel Programming | |||
Moving data from Excel to Access | Excel Programming | |||
REPOST:Need help moving XL2K to XLXP, please | Excel Programming | |||
moving data between excel and access | Excel Programming |