Does anyone know the fastest way to get data from and Excel table (VBA Array) to a table on SQL 2008 without using an external utility (i.e. bcp)?
Keep in mind my datasets are usually 6500-15000 rows, and about 150-250 columns; and I end up transferring about 20-150 of them during an automated VBA batch script.
I have tried several methods for getting large amounts of data from an Excel table (VBA) to SQL 2008. I have listed those below:
Method 1. Pass table into VBA Array and send to stored procedure (ADO)
-- Sending to SQL is SLOW
Method 2. Create disconnected RecordSet load it, then sync.
-- Sending to SQL VERY SLOW
Method 3. Put table into VBA array, loop though the array and concatenate(using delimiters) then send to stored procedure.
-- Sending to SQL SLOW, but faster than Method 1 or 2.
Method 4. Put table into VBA array, loop though the array and concatenate(using delimiters) then place each row with ADO recordset .addnew command.
--Sending to SQL very FAST (about 20 times faster than methods 1-3), but now I will need to split that data using a separate procedure, which will add significant wait time.
Method 5. Put table in VBA array, serialize into XML, send to stored procedure as VARCHAR and specify XML in stored procedure.
--Sending to SQL INCREDIBLY SLOW (about 100 times slower than methods 1 or 2)
Anything I am missing?
There is no single fastest way, as it's dependent on a number of factors. Make sure the indexes in SQL are configured and optimized. Lots of indexes will kill insert/update performance since each insert will need to update the index. Make sure you only make one connection to the database, and do not open/close it during the operation. Run the update when the server is under minimal load. The only other method you haven't tried is to use a ADO Command object, and issue a direct INSERT statement. When using the 'AddNew' Method of the recordset object, be sure to issue only one 'UpdateBatch' Command at the end of the inserts. Short of that, the VBA can only run as fast as the SQL server accepting the inputs.
EDIT:
Seems like you've tried everything. There is also what is known as 'Bulk-Logged' recovery mode in SQL Server, that reduces the overhead of writting so much to the transaction log. Might be something worth looking into. It can be troublesome since it requires fiddling with the database recovery model a bit, but it could be useful for you.
The following code will transfer the thousands of data in just few seconds(2-3 sec).
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Sheets("DataSheet")
Dim Con As Object
Dim cmd As Object
Dim ServerName As String
Dim level As Long
Dim arr As Variant
Dim row As Long
Dim rowCount As Long
Set Con = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")
ServerName = "192.164.1.11"
'Creating a connection
Con.ConnectionString = "Provider=SQLOLEDB;" & _
"Data Source=" & ServerName & ";" & _
"Initial Catalog=Adventure;" & _
"UID=sa; PWD=123;"
'Setting provider Name
Con.Provider = "Microsoft.JET.OLEDB.12.0"
'Opening connection
Con.Open
cmd.CommandType = 1 ' adCmdText
Dim Rst As Object
Set Rst = CreateObject("ADODB.Recordset")
Table = "EmployeeDetails" 'This should be same as the database table name.
With Rst
Set .ActiveConnection = Con
.Source = "SELECT * FROM " & Table
.CursorLocation = 3 ' adUseClient
.LockType = 4 ' adLockBatchOptimistic
.CursorType = 0 ' adOpenForwardOnly
.Open
Dim tableFields(200) As Integer
Dim rangeFields(200) As Integer
Dim exportFieldsCount As Integer
exportFieldsCount = 0
Dim col As Integer
Dim index As Integer
index = 1
For col = 1 To .Fields.Count
exportFieldsCount = exportFieldsCount + 1
tableFields(exportFieldsCount) = col
rangeFields(exportFieldsCount) = index
index = index + 1
Next
If exportFieldsCount = 0 Then
ExportRangeToSQL = 1
GoTo ConnectionEnd
End If
endRow = ThisWorkbook.Sheets("DataSheet").Range("A65536").End(xlUp).row 'LastRow with the data.
arr = ThisWorkbook.Sheets("DataSheet").Range("A1:CE" & endRow).Value 'This range selection column count should be same as database table column count.
rowCount = UBound(arr, 1)
Dim val As Variant
For row = 1 To rowCount
.AddNew
For col = 1 To exportFieldsCount
val = arr(row, rangeFields(col))
.Fields(tableFields(col - 1)) = val
Next
Next
.UpdateBatch
End With
flag = True
'Closing RecordSet.
If Rst.State = 1 Then
Rst.Close
End If
'Closing Connection Object.
If Con.State = 1 Then
Con.Close
End If
'Setting empty for the RecordSet & Connection Objects
Set Rst = Nothing
Set Con = Nothing
End Sub
By far the fastest way to do this is via T-SQL's BULK INSERT.
There are a few caveats.
You will likely need to export your data to a csv first (you may be able to import directly from Excel; my experience is in going from Access .mdbs to SQL Server which requires the interim step to csv).
The SQL Server machine needs to have access to that csv (when you run the BULK INSERT command and specify a filename, remember that the filename will be resolved on the machine where SQL Server is running).
You may need to tweak the default FIELDTERMINATOR and ROWTERMINATOR values to match your CSV.
It took some trial and error for me to get this set up initially, but the performance increase was phenomenal compared to every other technique I had tried.
works pretty fine, on the other hand to improve speed we may still modify the query:
Instead: Source = "SELECT * FROM " & Table
We can use: Source = "SELECT TOP 1 * FROM " & Table
Here is we only need column names. So no need to maka a query for entire table, which is extending the process as long as new data imported.
As far as I remember, you can create a linked server to the Excel file (as long as the server can find the path; it's best to put the file on the server's local disk) and then use SQL to retrieve data from it.
Having just tried a few methods, I came back to a relatively simple but speedy one. It's fast because it makes the SQL server do all the work, including an efficient execution plan.
I just build a long string containing a script of INSERT statements.
Public Sub Upload()
Const Tbl As String = "YourTbl"
Dim InsertQuery As String, xlRow As Long, xlCol As Integer
Dim DBconnection As New ADODB.Connection
DBconnection.Open "Provider=SQLOLEDB.1;Password=MyPassword" & _
";Persist Security Info=false;User ID=MyUserID" & _
";Initial Catalog=MyDB;Data Source=MyServer"
InsertQuery = ""
xlRow = 2
While Cells(xlRow, 1) <> ""
InsertQuery = InsertQuery & "INSERT INTO " & Tbl & " VALUES('"
For xlCol = 1 To 6 'Must match the table structure
InsertQuery = InsertQuery & Replace(Cells(xlRow, xlCol), "'", "''") & "', '" 'Includes mitigation for apostrophes in the data
Next xlCol
InsertQuery = InsertQuery & Format(Now(), "M/D/YYYY") & "')" & vbCrLf 'The last column is a date stamp, either way, don't forget to close that parenthesis
xlRow = xlRow + 1
Wend
DBconnection.Execute InsertQuery 'I'll leave any error trapping to you
DBconnection.Close 'But do be tidy :-)
Set DBconnection = Nothing
End Sub
Related
Hi I currently have two worksheets in an excel file with one of them acting as a database of all the products we sell, with the columns Product ID, Product Code, and Description (sample below).
I have another worksheet that acts as a product finder tool, where you would paste multiple Product IDs in the first column and it would return the Product code and Description in the adjacent columns (image below).
I currently use an INDEX search to make this happen, but the database sheet has become too big to manage in the same file, leading to severe slow downs. What would be the easiest solution for this? I was thinking of separating the database sheet as an Excel or AccessDB file but I think I will need a lot of VBA manipulation if I do that. Any help would be much appreciated.
You can access your data in Microsoft Access using ADO and doing a SQL query to gather data.
Could you tell me if it's possible to give a cell range to the WHERE clause?
Yes, there is a trick. SQL commands are plain text, you just need to build it with your parameters. Use the operator IN in the WHERE clause.
I made a fake dataset as example. Here's my Excel Product Finder (a table named Table1):
Notice I want the info only of products 6,3 and 2. Now my fake database:
The code to query those specific products:
Sub TEST()
Dim cnn As Object
Dim RST As Object
Dim DatabasePath As String
Dim i As Long
Dim Allid As String
Dim Arrayid As Variant
Dim SQLQuery As String
DatabasePath = "C:\Temp\temp.accdb" 'path to database
'Create a connection object.
Set cnn = CreateObject("ADODB.Connection")
'Create recordset object
Set RST = CreateObject("ADODB.Recordset")
'Open a connection using the OLE DB connection string.
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DatabasePath & ";Persist Security Info=False;"
'merge all ID into one single string
Arrayid = Range("Table1[PRODUCT ID]").Value
For i = LBound(Arrayid) To UBound(Arrayid) Step 1
Allid = Allid & Arrayid(i, 1) & ","
Next i
Allid = Left(Allid, Len(Allid) - 1) 'get rid of last comma
Erase Arrayid 'clean array variable
'specify query
SQLQuery = "SELECT PRODUCT_TABLE.[Product Id], PRODUCT_TABLE.[Product Code], PRODUCT_TABLE.Description FROM PRODUCT_TABLE " & _
"WHERE PRODUCT_TABLE.[Product Id] In (" & Allid & ") ORDER BY PRODUCT_TABLE.[Product Id]"
'Open a recordset using the Open method
'and use the connection established by the Connection object.
RST.Open SQLQuery, cnn
'copy all data into cells. This will bring full query without headers
Range("A6").CopyFromRecordset RST
'close and clean variables
RST.Close
cnn.Close
Set RST = Nothing
Set cnn = Nothing
End Sub
After executing code I get this:
NOTICE that the output is not sorted as we had before. We asked the products in order 6,3,2 but the output is 2,3,6!
This is because my SQL query got the operator ORDER BY that sorts by ID field. If there is no ORDER BY clause the output will be sorted as it is in the database stored, not as your Excel.
If you really really really need the output to be exactly in the same order that your Product Finder, you can create an UDF function to query each single id once and return a single row for each product but if you work with a lot of data this can consume a lot of time. So think carefully how to approach this part.
By the way, make sure you use the right connection string. You can find many on Access connection strings
I have a database of about 400,000 records and would like to search the index result of these to another column to check if it exists or not. I would like it to record even if only a partial string exists. I have an example I have tried in Excel. It takes a very long time to process 100,000 records (4 hours) with 4 cores at 2.8ghz. I figured doing this in MS Access will be faster. Can this be done faster in MS Access? I will paste the code here...
=INDEX($A:$A,AGGREGATE(15,7,ROW($A:$A)/(ISNUMBER(SEARCH($C2,$A:$A))),COLUMN(A:A)))
Is there a way to do this in MS Access with VBA code or a query.
Yes, it can be done although I am not sure it will be faster. Have a table of the library strings and another table for the database strings.
Option using queries requires a unique identifier field in each table. The text strings might serve for that purpose but I recommend a number. If not already in each table add an autonumber field.
Consider:
Query1: LibDB
SELECT [DB_ID]+[LIB_ID] AS ID, DB.WordDB, Lib.WordLib
FROM Lib, DB
WHERE (((InStr([WordLib],[WordDB]))>0))
ORDER BY DB.WordDB, Lib.WordLib;
Query2
TRANSFORM First(LibDB.WordLib) AS FirstOfWordLib
SELECT LibDB.WordDB
FROM LibDB
GROUP BY LibDB.WordDB
PIVOT DCount("*","LibDB","WordDB='" & [WordDB] & "' AND ID<" & [ID])+1;
This is very fast with sample data provided but may perform so slowly with large dataset as to be non-functional.
For a VBA approach, create a table Result with fields named WordDB, F1, F2, etc. Include as many Fn fields as might be needed up to 254. Then procedure in a general module like:
Sub StringMatch()
Dim rsDB As DAO.Recordset, rsLIB As DAO.Recordset, rsRST As DAO.Recordset, n As Integer
Set rsDB = CurrentDb.OpenRecordset("SELECT WordDB FROM DB ORDER BY WordDB")
Set rsRST = CurrentDb.OpenRecordset("SELECT * FROM Result WHERE 1=1")
n = 1
CurrentDb.Execute "DELETE FROM Result"
Do While Not rsDB.EOF
rsRST.AddNew
Set rsLIB = CurrentDb.OpenRecordset("SELECT WordLib FROM Lib " & _
"WHERE InStr([WordLib],'" & rsDB!WordDB & "') > 0 ORDER BY WordLib;")
rsRST!WordDB = rsDB!WordDB
Do While Not rsLIB.EOF And n < 255
rsRST("F" & n) = rsLIB!WordLib
n = n + 1
rsLIB.MoveNext
If rsLIB.EOF Then
rsRST.Update
n = 1
End If
Loop
rsLIB.Close
rsDB.MoveNext
Loop
End Sub
Regardless of method, output is limited to 255 columns.
If you want to stay with Excel, open recordsets of column data and feed results to cells. No idea if this will be faster than your Excel function or Access.
Dim rsLIB As New ADODB.Recordset, rsDB As New ADODB.Recordset, c As Integer, r As Integer
Dim cnx As New ADODB.Connection
'setup the connection
'[HDR=Yes] means the Field names are in the first row
cnx.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source='" & ThisWorkbook.FullName & "';" & _
"Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
rsDB.Open "SELECT Database FROM [Sheet1$] WHERE NOT Database Is Null", _
cnx, adOpenDynamic, adLockOptimistic
c = 3
r = 2
Do While Not rsDB.EOF
rsLIB.Open "SELECT Library FROM [Sheet1$] " & _
"WHERE InStr([Library],'" & rsDB!Database & "')>0 ORDER BY Library", _
cnx, adOpenDynamic, adLockOptimistic
Do While Not rsLIB.EOF
Worksheets("Sheet1").Cells(r, c).Value = rsLIB!Library
rsLIB.MoveNext
c = c + 1
Loop
c = 3
rsLIB.Close
r = r + 1
rsDB.MoveNext
Loop
In excel I have a linked table to a access table "tbl_Output"
Currently there is a manual step that before I run a excel macro I have to go into the database and open up a create table query and manual enter a criteria and run. Call it Field "Vendor Name"
This vendor name exists in the excel document. Is it possible to declare that variable in excel, pass it to access and run the create table query using that variable as its criteria.
The task gets run for many vendors so if I can automate this step I can create a loop to go through all vendors.
I have tried a workaround by having a linked pivot table to the data source that the create table query is based off then filtering in the excel pivot table itself but due to the large amount of data the refresh takes too long.
Apologies if this is something obvious. Coding vba with access is something im not familiar with.
Not 100% on the question that is being asked but I'm gonna take a shot at it. The code below will take a list of Vendor Names [Vendor Ids] and will loop through the list executing a create table query for each of the Vendor Ids that contains the information for that specific Vendor
Sub umCreateDBTables()
Dim DBPath As String ' Path to the database with the information
Dim DBPath2 As String ' Path to the database to store the newly created tables in
Dim xlCell As Range
Dim sSQL As String
Dim DB As DAO.Database
Dim VenID As String
Dim i As Integer
DBPath = "C:\DB_Temp\AccessDB_A.accdb"
DBPath2 = "C:\DB_Temp\AccessDB_B.accdb"
Set DB = OpenDatabase(DBPath, True, False)
Set xlCell = Range("A2") ' Assumes that this is the beginning of the column with your vendor ids
Do Until xlCell.Value = "" ' Loops through the list of vendor ids until it gets to an empty cell
VenID = "v_" & xlCell.Value ' would be best to feed this through a function to strip out any invalid db field name characters
sSQL = "SELECT T1.F1, T1.F2, T1.F3, INTO " & VenID & " IN '" & DBPath2 & "' FROM T1 WHERE (((T1.F1)='" & xlCell.Value & "'));"
For i = DB.TableDefs.Count - 1 To 0 Step -1 ' Cycle through the list of database objects [tables, queries, etc....]
If DB.TableDefs(i).Name = VenID Then ' If the vendor table already exists in the DB, delete it so it can be recreated
DB.TableDefs.Delete (VenID)
End Select
Next i
DB.Execute sSQL ' Run the SQL to create the vendor table
Set xlCell = xlCell.Offset(1, 0) ' move down to the next row
Loop
DB.Close
Set DB = Nothing
Set xlCell = Nothing
End Sub
Hope this helps
Thank you so much Glenn G
The code you provided was extremely helpful and put me in the right direction.
I was having run-time issues with the DAO even with references added though but worked around it.
Code I got to work was:
Sub UpdateDatabase()
Dim DBPath As String
Dim xlcell As Range
Dim sSQL As String, stProvider As String
Dim DB As New ADODB.Connection
DBPath = "C:\Temp\Data.accdb"
stProvider = "Microsoft.ACE.OLEDB.12.0"
With DB
.ConnectionString = DBPath
.Provider = stProvider
.Open
End With
Set xlcell = Sheet3.Range("X2")
Do Until xlcell.Value = ""
venid = xlcell.Value
sSQL = "SELECT ALL * INTO tbl_Output FROM qry_Data WHERE (((qry_Data.VendorName)='" & xlcell.Value & "'));"
DB.Execute "DROP TABLE tbl_Output;"
DB.Execute sSQL
Set xlcell = xlcell.Offset(1, 0)
Loop
DB.Close
Set DB = Nothing
Set xlcell = Nothing
Thank you again for your help.
Regards
Richard
I want to make a simple function that will open and read from a database (and mdb file). As simply and cleanly as possible. Preferably using only ADODB.
For now I need this from excel/vba and I will later migrate to vb.net
First the structure of my database
A single mdb file (actually, accdb, it doesn't matter I hope)
It has a single table called "myParts"
This table has 3 columns: id, part number, part description
Here is how the function I want to make
function GetPartDescription (PartNumber as string) as string
The part number should exist only once in the entire table.
So this function should, open the database, find the row with the exact matching part number and then return whatever is in the "part description" column for that row
How should I do this ? I tried getting started by just choosing which api, I get lost ! DAO , ADO, ACEDAO, ADODB, ADO.NET, OLEDB ??? What a nightmare !
IMO this question should be closed as too broad but let's give it a try
The following function will connect to a Access database via ADODbD
Function ConnectToDB(ByVal fileName As String)
Dim conn As New ADODB.Connection
If Dir(fileName) = "" Then
MsgBox "Could not find file " & fileName
Exit Function
End If
Dim connectionString As String
' https://www.connectionstrings.com/access/
connectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" _
& fileName & ";Persist Security Info=False;"
conn.Open connectionString
Set ConnectToDB = conn
End Function
And this might give you what you want. You need a sheet with the codename shRepAllRecords to make it work.
Option Explicit
Sub ReadFromDB()
' Get datbase name
Dim dbName As String
dbName = <fule filename of the database>
' Connect to the databse
Dim conn As ADODB.Connection
Set conn = ConnectToDB(dbName)
' read the data
Dim rs As New ADODB.Recordset
Dim query As String
' First example to use an SQL statement
query = "SELECT * From myParts WHERE PartNumber = '123'"
' Second example to use a query name defined in the database itself
' query = "qryCustomer"
rs.Open query, conn
' shRepAllRecords is the codename of the sheet where the
' data is written to
' Write header
Dim i As Long
For i = 0 To rs.Fields.Count - 1
'shRepAllRecords.Cells(1, i + 1).Value = rs.Fields(i).Name
shRepAllRecords.Range("A1").Offset(0, i) = rs.Fields(i).Name
Next i
' Write Data
shRepAllRecords.Range("A2").CopyFromRecordset rs
shRepAllRecords.Activate
' clean up
conn.Close
End Sub
You need to adjust the code in order to get excatly what you need but I leave that to you.
I've got some queries I have connected to an excel sheet that I refresh in order to get the latest data.
Is it possible to make excel "ask" for input parameters for one column lets say?
I am looking to get data by company so wondering if it's possible to do it as in access (type [company]:) in the field criteria
If I save the query like that in access it won't let me connect it to excel
Thanks
Alright another edit.
Here it is, I created a database, its simple.
The database is called "Database1.accdb"
There are more records than shown in the screen shot.
I created a workbook with one sheet, its name is "AccessDBtest.xlsm"
I created a button on Sheet1 and entered the field parameter I wanted in the cell beside it, C3 or (3,3) in (row,col) format.
This is the code that works returning the data set (without field names) based on the input criteria. I made a msgBox before the SQL query execution so that I could look at it first. You don't need that if you do not want it, good for testing.
Private Sub CommandButton1_Click()
Dim inputSheet As Worksheet
Dim fieldSTR As String
Dim placementRange As Range
Dim rs As Object 'record set
Dim conn As Object
Dim strQuery As String
Dim myDB As String
Set inputSheet = ThisWorkbook.Worksheets("Sheet1")
Set placementRange = inputSheet.Range("E2")
fieldSTR = CStr(inputSheet.Cells(3, 3).Value) 'C3 cell
myDB = "C:\Users\Documents\0_Excel Projects\Testing\Database1.accdb"
Set conn = CreateObject("ADODB.Connection")
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0" 'For *.ACCDB Databases
.ConnectionString = myDB
.Open
End With
strQuery = "SELECT * FROM " & _
"tbl_test WHERE tbl_test.Color = " & "'" & fieldSTR & "'" & ";"
'The below gives the same result as * but you could limit the fields returned as well
'tbl_test.ID, tbl_test.Color, tbl_test.number
'just using Color also works you do not need to reference the table directly
MsgBox (strQuery)
Set rs = conn.Execute(strQuery)
placementRange.CopyFromRecordset rs
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
End Sub
See if you can map what you want to do using that.
I wanted to capture a string from a cell and then use that string in the query.
Here is the MsgBox before the query executes (what access will see):
I tested it with * for all fields and below you can see that I called up specific fields, they both work.
And here is what happens after I clear the msgBox, the recordset is pulled and pasted starting in the range I specified Range.("E3") on the sheet I specified (Sheet1)
As you can see, we can pull queries from a database using input that is found on a current sheet.
Let me know if this helps your situation.
We can dig deeper if required.
-WWC