goss
Active Member
- Joined
- Feb 2, 2004
- Messages
- 372
Hi all,
My SQL INSERT snippet is only yielding 28,739 records. However there are 421,956 record on my Excel worksheet:
Any idea why this may be?
Full code below
thx
w
My SQL INSERT snippet is only yielding 28,739 records. However there are 421,956 record on my Excel worksheet:
Code:
'Load to Access table
'SQL
strSQL9 = "INSERT INTO tmp_Table SELECT * FROM [tmpf$] IN '" _
& ThisWorkbook.FullName & "' 'Excel 8.0;'"
'Do it
cnt.Execute (strSQL9)Any idea why this may be?
Full code below
thx
w
Code:
Option Explicit
Sub ImportRecords()
'
'Imports all records from the specified table
'Uses Microsoft ActiveX Data Objects 2.7 Library
'
'Date Developer Action
'---------------------------------------------
'01/20/12 ws Created
'01/20/12 ws Temorary worksheet delete process is commented out
Dim wb As Workbook
Dim ws As Worksheet
Dim wstmp As Worksheet
Dim wstmpf As Worksheet
Dim wsTitle As Worksheet
Dim strDBPath As String
Dim strDb As String
Dim strDBTable As String
Dim strDBPathFile As String
Dim cnt As ADODB.Connection
Dim rst1, rst2, rst3, rst4, rst5, rst6, rst7, rst8 As ADODB.Recordset
Dim strSQL1, strSQL2, strSQL3, strSQL4, strSQL5, strSQL6, strSQL7, strSQL8, strSQL9 As String
Dim stConn As String
Dim strFormula As String
Dim lngRows As Long
'Initialize
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
lngRows = 0
strFormula = "=C2&""_""&A2"
'Instantiate objects
Set cnt = New ADODB.Connection
Set rst1 = New ADODB.Recordset
Set rst2 = New ADODB.Recordset
Set rst3 = New ADODB.Recordset
Set rst4 = New ADODB.Recordset
Set rst5 = New ADODB.Recordset
Set rst6 = New ADODB.Recordset
Set rst7 = New ADODB.Recordset
Set rst8 = New ADODB.Recordset
Set wb = ThisWorkbook
Set ws = wb.Worksheets("ImportRecs")
Set wsTitle = wb.Worksheets("iTitle")
'Temprary worksheets to handle data
wb.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "tmp"
wb.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "tmpf"
Set wstmp = wb.Worksheets("tmp")
Set wstmpf = wb.Worksheets("tmpf")
'Get database string values
With ws
strDBPath = .Range("C4")
strDb = .Range("C5")
strDBTable = .Range("C6")
End With
' Get the database name.
strDBPathFile = strDBPath
If Right$(strDBPathFile, 1) <> "\" Then strDBPathFile = strDBPathFile & _
"\"
strDBPathFile = strDBPathFile & strDb
'Connection String
stConn = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & strDBPathFile & ";"
'SQL-statements to be executed.
strSQL1 = " SELECT OrderID FROM Orders "
strSQL2 = " SELECT CustomerID FROM Orders "
strSQL3 = " SELECT OrderDate FROM Orders "
strSQL4 = " SELECT ShipName FROM Orders "
strSQL5 = " SELECT CompanyName" & _
" FROM Customers " & _
" LEFT OUTER JOIN Orders " & _
" ON Customers.CustomerID " & _
" = Orders.CustomerID"
strSQL6 = " SELECT ShipPostalCode FROM Orders "
strSQL7 = " SELECT ContactName" & _
" FROM Customers " & _
" LEFT OUTER JOIN Orders " & _
" ON Customers.CustomerID " & _
" = Orders.OrdersID"
strSQL8 = " SELECT Status FROM Orders "
With cnt
.Open (stConn) 'Open the connection.
.CursorLocation = adUseClient 'Necessary to disconnect the recordset.
End With
With rst1
.Open strSQL1, cnt 'Create the recordset.
Set .ActiveConnection = Nothing 'Disconnect the recordset.
End With
With rst2
.Open strSQL2, cnt 'Create the recordset.
Set .ActiveConnection = Nothing 'Disconnect the recordset.
End With
With rst3
.Open strSQL3, cnt 'Create the recordset.
Set .ActiveConnection = Nothing 'Disconnect the recordset.
End With
With rst4
.Open strSQL4, cnt 'Create the recordset.
Set .ActiveConnection = Nothing 'Disconnect the recordset.
End With
With rst5
.Open strSQL5, cnt 'Create the recordset.
Set .ActiveConnection = Nothing 'Disconnect the recordset.
End With
With rst6
.Open strSQL6, cnt 'Create the recordset.
Set .ActiveConnection = Nothing 'Disconnect the recordset.
End With
With rst7
.Open strSQL7, cnt 'Create the recordset.
Set .ActiveConnection = Nothing 'Disconnect the recordset.
End With
With rst8
.Open strSQL8, cnt 'Create the recordset.
Set .ActiveConnection = Nothing 'Disconnect the recordset.
End With
'Copy recordsets
With wstmp
.Cells(2, 1).CopyFromRecordset rst1
.Cells(2, 2).CopyFromRecordset rst2
.Cells(2, 3).CopyFromRecordset rst3
.Cells(2, 4).CopyFromRecordset rst4
.Cells(2, 5).CopyFromRecordset rst5
.Cells(2, 6).CopyFromRecordset rst6
.Cells(2, 7).CopyFromRecordset rst7
.Cells(2, 8).CopyFromRecordset rst7
End With
'Add Customer Site (Cust_Site)
With wstmp
.Range("D1").EntireColumn.Insert
lngRows = .Cells(Rows.Count, 1).End(xlUp).Row 'Find last Row
.Range("D2:D" & lngRows).Formula = strFormula 'Create Cust_Site
End With
'Add Header Row
wsTitle.Range("D8:L8").Copy Destination:=wstmp.Range("A1")
'Copy data to sheet tmpf for final export to Access
wstmp.Range("A1:I" & lngRows).Copy
wstmpf.Range("A1").PasteSpecial (xlPasteValues)
wstmpf.Range("A1").PasteSpecial (xlPasteFormats)
'Format sheet tmpf
wstmpf.Activate
ActiveWindow.Zoom = 75
Rows("2:2").Select
ActiveWindow.FreezePanes = True
wstmpf.Columns("A:I").EntireColumn.AutoFit 'RAD
'Load to Access table
'SQL
strSQL9 = "INSERT INTO Pegging_Table SELECT * FROM [tmpf$] IN '" _
& ThisWorkbook.FullName & "' 'Excel 8.0;'"
'Do it
cnt.Execute (strSQL9)
'Tidy up
'Delete temporary worksheets
'After RAD, remove comments
' wb.Worksheets.Delete ("tmp")
' wb.Worksheets.Delete ("tmpf")
'Destroy Objects
Set wb = Nothing
Set ws = Nothing
Set wsTitle = Nothing
Set wstmp = Nothing
Set wstmpf = Nothing
Set cnt = Nothing
Set rst1 = Nothing
Set rst2 = Nothing
Set rst3 = Nothing
Set rst4 = Nothing
Set rst5 = Nothing
Set rst6 = Nothing
Set rst7 = Nothing
Set rst8 = Nothing
'Reset Excel environment
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
End Sub
