getting data from Access using vba using data from excel - excel

I am trying to extract data from Access using a column of excel.
I have tried the following code but its not taking too much time when # of rows in excel exceed 5k rows. Does anyone know of a better way to reference the excel data to get the results:
Sub ddd()
Const dbloc As String = "C:\Users\mysystem\Downloads\Database11.accdb"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim xlbook As Workbook
Dim xlsheet As Worksheet
Dim a As Long
Dim SQL As String
Set xlbook = ActiveWorkbook
Set xlsheet = xlbook.Worksheets(1)
xlsheet.Range("B2:Z100000").ClearContents
Set db = OpenDatabase(dbloc)
SQL = "SELECT Material, MPN "
SQL = SQL & "FROM Sheet2 "
SQL = SQL & "WHERE Material IN ("
Dim r As Range
For Each r In Range("A2:A19098")
SQL = SQL & r.Text & ","
Next r
SQL = Left(SQL, Len(SQL) - 1) 'Drop last comma
SQL = SQL & ")"
' i want to change this for loop because my range might vary from 80-100k
rows and this method is not working. i got a suggestion here that i can
use a table for this. But i am new to macros and access and not sure of
the syntax. Can anyone please help with the syntax. Assuming tablename for
the excel data is column1 and ranges from a2:a100000
Set rs = db.OpenRecordset(SQL)
', dbOpenSnapshot)
If rs.RecordCount = 0 Then
MsgBox "No data retrieved from database", vbInformation + vbOKOnly, "No
Data"
GoTo SubExit
Else
rs.MoveLast
recCount = rs.RecordCount
rs.MoveFirst
End If
xlsheet.Range("C2").CopyFromRecordset rs
End Sub
Any help will me much appreciated. Thanks!!

If you're looking for an alternative way to reference an Excel column, you can use the following:
SQL = "SELECT Material, MPN "
SQL = SQL & "FROM Sheet2 "
SQL = SQL & "WHERE Material IN ("
SQL = SQL & "SELECT * FROM [A1:A19098] IN '"
SQL = SQL & ActiveWorkbook.FullName & "'"
SQL = SQL & " 'Excel 12.0 Macro;')"
This allows the DAO database engine to directly query your Excel file via OleDb, instead of passing each row as text, which should be more efficient.
The Excel file should be saved before you do this (and it's better to trigger it from a different file, but works for me when triggering from the same file).
Note that I am purposefully including 1 row more, because the first row contains column names when using this.
I'm assuming you're using a .xlsm file.

Related

Execute sql complex query through excel vba

Just to give you background of my work, i have to fetch data from MS Sql on daily basis and for that every time have to go to other server to run the query. Once the query is executed, have to paste into my common drive, which takes a lot time. ~55 mins to paste 5,00,000 row & 30 fields to common or to move file. In total 2 hours for execution & movement from one location to other.
To reduce this i would need your help to use the SQL queries through excel with the below things:
If possible,
Point1: Query will be stored in the text file in the common location
Point2: Query Parameter to be populate to get
Or
Point2:Range to be defined for parameter
If not possible above,
Query will be pasted into the code and parameter to be populated based on the above mentioned suggestion.
Connection type is windows authentication, it will work based on logged in users windows name.
This code will allow you to provide variables that you use within your SQL statement and put those into cells on a spreadsheet (In this case Cred2) and return the results on a separate sheet (Sheet2).
The first portion of the code establishes a connection with the SQL server.
The column Headers will be started in Row 2 and then the data will begin populating starting on row 3. I have used this to pull well over 100,000 records at a time and this works very quickly.
Private Sub CommandButton1_Click()
Dim cn As Object
Dim rs As Object
Dim strCon As String
Dim strSQL As String
strCon = "DRIVER=SQL Server;SERVER=ServerName;DATABASE=DBName;Trusted_Connection=True"
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
' if not a trusted connection you could replace top line of strCon with
strCon = "DRIVER=SQL Server; Server=myServerAddress;Database=myDataBase;User Id=myUsername; Password=myPassword"
' set up where you are getting your variables to include in the SQL statement
stat = Sheets("Cred2").Range("c7").Value
barg = Sheets("Cred2").Range("c10").Value
worksite = Sheets("Cred2").Range("c11").Value
' Construct SQL statement
strSQL = "select * " _
& " FROM tableName A , table2 B " _
& "WHERE A.[field1] = B.[field1] " _
& " and field1 like '" & stat & "'" _
& "and field2 like '" & barg & "'" _
& "and field3 like '" & worksite & "'" _
& " order by Field? "
' Build Record Set
Set rs = CreateObject("ADODB.RECORDSET")
rs.ActiveConnection = cn
rs.Open strSQL
' Display Data
For intColIndex = 0 To rs.Fields.Count - 1
Sheet2.Range("A2").Offset(0, intColIndex).Value = rs.Fields(intColIndex).name
Next
Sheet2.Range("A3").CopyFromRecordset rs
' Close Database
rs.Close
cn.Close
Set cn = Nothing
end sub

Using Excel & Access Together passing a variable from excel to access

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

How to transfer an excel spreadsheet to an access database

I'm making a program to track my weight, calories I eat in a day, and the date, to help me lose weight. I'm manually putting in these values into a spreadsheet with those three columns (date, calories, weight). I want to transfer the information in these three columns into an access database.
Code so far:
Sub transferdata()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
connStr = "C:\Users\sachu\Desktop\Assignment 5\CalorieDatabase.mdb"
providerStr = "Microsoft.ACE.OLEDB.12.0"
With cn
.ConnectionString = connStr
.Provider = providerStr
.Open
End With
rs.Open sqlStr, cn
rs.Close
cn.Close
End Sub
So far my code is only starting the connection between access and excel
There are many ways to do this. Let's look at a couple of case studies.
Export data from Excel to Access (ADO)
If you want to export data to an Access table from an Excel worksheet, the macro example below shows how this can be done.
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\FolderName\DataBaseName.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value
.Fields("FieldName2") = Range("B" & r).Value
.Fields("FieldNameN") = Range("C" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Also . . .
Export data from Excel to Access (DAO)
If you want to export data to an Access table from an Excel worksheet, the macro example below illustrates another way to do this.
Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb")
' open the database
Set rs = db.OpenRecordset("TableName", dbOpenTable)
' get all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value
.Fields("FieldName2") = Range("B" & r).Value
.Fields("FieldNameN") = Range("C" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
Also . . .
Browse to a single EXCEL File and Import Data from that EXCEL File via TransferSpreadsheet (VBA)
Here's yet another way . . .
Sub TryThis()
Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False
strBrowseMsg = "Select the EXCEL file:"
' Change C:\MyFolder\ to the path for the folder where the Browse
' window is to start (the initial directory). If you want to start in
' ACCESS' default folder, delete C:\MyFolder\ from the code line,
' leaving an empty string as the value being set as the initial
' directory
strInitialDirectory = "C:\MyFolder\"
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
Filter:=strFilter, OpenFile:=False, _
DialogTitle:=strBrowseMsg, _
Flags:=ahtOFN_HIDEREADONLY)
If strPathFile = "" Then
MsgBox "No file was selected.", vbOK, "No Selection"
Exit Sub
End If
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "tablename"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
End Sub
I know this looks like a dead thread but I wanted to revive for Office 360 users. I had to compile an answer from several sources to make something workable. See below.
First- note that you need at least the 2 following references active in your Tools>References Menu.
Microsoft Access 16.0 Object Library &
Microsoft Office 16.0 Access Database Engine Object
You may also need to have:
Visual Basic for Applications//
Microsoft Excel 16.0 Object Library//
OLE Automation//
Microsoft Forms 2.0 Object Library//
Microsoft Outlook 16.0 Object Library//
Microsoft Office 16.0 Object Library
Sub rtnExporttoAccess()
Dim oDAO As DAO.DBEngine, oDB As DAO.Database, oRS As DAO.Recordset
Dim oSelect As Range, sPath As String, sRecordSet As String
Set sheet = ActiveWorkbook.Worksheets("YourSheet") 'excel sheet
Set table = sheet.ListObjects.Item("YourTable") 'excel table
Set oSelect = table.ListRows(table.ListRows.Count).Range 'set your sheet and range however you want
sPath = "your database file path"
sRecordSet = "the title of the table in that database" 'access table
Set oDAO = New DAO.DBEngine
Set oDB = oDAO.OpenDatabase(sPath)
Set oRS = oDB.OpenRecordset(sRecordSet)
oRSct = oRS.Fields.Count
xclFieldCt = table.ListColumns.Count
If oRSct > xclFieldCt Then
intTargetCt = oRSct
Else
intTargetCt = xclFieldCt
End If
For i = 2 To oSelect.Rows.Count
oRS.AddNew
'finds the correct fields to add data to
For j = 0 To intTargetCt - 1 'access is base 0 so the end is always -1
oRSHeaderName = oRS.Fields(j).Name 'gets database table variable header name
For col = 1 To intTargetCt 'excel is base 1
lastRowHeaderName = table.HeaderRowRange(1, col) ' gets excel table variable header name
If oRSHeaderName = lastRowHeaderName Then 'this verifies both headers are the same
oRS.Fields(j) = Now
Exit For
End If
If oRSHeaderName = "Pass/Failed" And lastRowHeaderName = "Pass/Failed" Then 'this verifies the you are putting the data where you want it if headers arent the same.
oRS.Fields(j) = cbxPF
Exit For
End If
Next col
Next j
oRS.Update
Next i
oDB.Close
End Sub
ASH's second DAO option is basically what this code is as well. I included the references and gave some extra options for you to see some more examples.
Creat a stand alone Acces DB then link the Excel in it. The Access has tools to import data from Excel with live communication.
Follow this:
Open MS Access
Creat new blank database (in this step you have to give name to the database, and set the save location)
In the new database on External Data tab choose the correct type to add based on what you want to import (in this case you have to select Excel)
in the earlier MS Access version the popular insertable things were stretched
in the 2016 version, and O365 the options is more compact so there is one option called New Data Source which contain all possibilities
The import progress consits of several steps.
you have to select the source and set how you want to import data. You can import data into a new table in Access as a copy, or you can connect the source of data to the Access database. Select connect source data for live communication.
select inner data source (for example which sheet, or range you want to import)
set if the first row contain headers
give a name to the linked table
Finally data from Excel linked into Access and it will update when you use it.

Using ADO VBA to Insert Excel Fields into Access Table

I am trying to use ADO to access and read some things from an Excel File. I understand how to get it open and do the SELECT * and put that into a Recordset Object. What I don't understand is if I am select a group of info, how to access specific fields in that Recordset.
Code:
Private Sub SaveReq_Click()
'
' Saves the current entry to the database
' Into the TABLE 'pr_req_table'
'
' Open a connection to the database
dim data_base as Database
set data_base = OpenDatabase(CurrentProject.Path & "\test_database.accdb")
Sub InsertRecord()
Dim data_base As Database
Set data_base = OpenDatabase(CurrentProject.Path & "\test_database.accdb")
' Grab all information from form
' Add information to pr_req_table
Dim qd As QueryDef
Set qd = data_base.CreateQueryDef("")
qd.sql = "INSERT INTO pr_req_table(pr_no, pr_date, pr_owner, pr_link, pr_signed) " & _
"values([p1],[p2],[p3],[p4],[p5])"
qd.Parameters("p1").Value = pr_num.Value
qd.Parameters("p2").Value = Format(pr_date.Value, "mm/dd/yyyy")
qd.Parameters("p3").Value = List22.Value
qd.Parameters("p4").Value = "Excel Copy #" & elec_copy.Value
qd.Parameters("p5").Value = "Signed Copy #" & sign_copy.Value
qd.Execute
' The following section reads from the elec_copy field's hyperlink
' It scans the Excel file for items it needs to include into the table
' It enters those cells into the TABLE 'items_needed_table'
'
' Slects row by row, and if the item has been marked TRUE, inserts
' That row into the TABLE 'items_needed_table'
' Open a connection to Excel
On Error Resume Next
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & elec_copy.Value & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"";"
' Decalre a RecordSet Object
Set objRecordSet = CreateObject("ADODB.Recordset")
' Grab all Rows in the Plain_VDR Sheet where 'needed' column == TRUE
objRecordset.Open "Select line_no, desc, weeks FROM [Plain_VDR$] Where needed = TRUE", _
objConnection, adOpenStatic, adLockOptimistic, adCmdText
' Declare a loop counter for row?
Dim x as Integer
x = 0
' Write the information pulled, into the TABLE 'items_needed_table' in Access Database
Do Until objRecordset.EOF
qd.sql = "INSERT INTO items_needed_table(pr_no, line_no, desc, weeks) " & _
"Values([p1],[p2],[p3])"
' p1 was declared earlier in code, same value as before
qd.Parameters("p2").Value = objRecorset.(ROW_X, "line_no")
qd.Parameters("p3").Value = objRecordset.(ROW_X, "desc")
qd.Parameters("p4").Value = objRecordset.(ROW_X, "weeks")
qd.Execute
x = x + 1
Loop
' Close Database connection
data_base.Close
End Sub
My main point of concern is the 'Do Until' loop section. Doubtful I can insert the entire selection, because 'pr_no' is not defined in the Excel file, but back in Access Database, so I think I will need to loop that command for each row in the Excel file.
What do I need to use to assign my parameters the values, per row and field, from the Recordset Object?
Thanks in advance for any help!
Nathan
In your connection string, you have said HDR=Yes, which means that the first row of your range contains the names of your fields, so, very roughly:
Do Until objRecordset.EOF
qd.Sql = "INSERT INTO items_needed_table(pr_no, line_no, desc, weeks) " & _
"Values([p1],[p2],[p3])"
' p1 was declared earlier in code, same value as before
'**No it was not, the earlier stuff is mostly irrelevant
qd.Parameters("p2").Value = objRecorset.Fields("line_no")
qd.Parameters("p3").Value = objRecordset.Fields("desc")
qd.Parameters("p4").Value = objRecordset.Fields("weeks")
qd.Execute
''You are moving through a recordset, not a worksheet
objRecordset.MoveNext
Loop
If this all that you are doing with the selection from Excel, it could be inserted with one query, because you are not changing pr_num.

Fastest way to transfer Excel table data to SQL 2008R2

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

Resources