VBA to export large tables from Excel to SQL Server

[Ajacoa]

I have spreadsheets that I distribute to users. I want Excel VBA to export
large tables (2000+ rows) into a remote SQL Server 2005. I am able to
successfully do this with the following generic code, but it is too slow:

Dim con As ADODB.Connection
Set con = New ADODB.Connection
con.Open "Driver={SQL
Server};SERVER=<server>;DATABASE=TestSample;UID=<id>;PWD=<pw>;"
con.Execute "INSERT INTO ... SELECT * FROM ..." 'Looping this for each
row

It takes over 10 minutes because it does it one line at a time.

I've also tried looping "ADODB.Recordset.addnew" ending with
".UpdateBatch", but it also is too slow, seems to still only be able to
transfer the table data one row at a time (unless I'm doing something wrong).


Is it really true that VBA/ADO can only export one row at a time?
Is there some other way to improve performance (send the whole data range at
one time)? For example, send the entire table to a SQL Server stored
procedure or BCP (whatever that is). If so, how would it work? Is there a
way to write the stored procedure generic enough to accept a variety of
tables, for example by receiving parameters indicating what SQL table they go
into and if it replaces or appends existing data?

 

[joel]

I've uploaded a pretty large database with the following code and i
didn't take a long time. See macro below

You could export your spreadshet as CSV and then import the data int
the SQL server in CSV format.


Sub Submit()
'filename of database is with MakeDatabase macro

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Set sht = ThisWorkbook.Sheets("USA")

strdb = Folder & FName

If Dir(strdb) = "" Then
MsgBox ("Database Doesn't Exists, Create Database" & strdb)
MsgBox ("Exiting Macro")
Exit Sub
End If

ConnectStr = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Folder & FName & ";" & _
"Mode=Share Deny None;"

cn.Open (ConnectStr)
With rs
.Open Source:="USA", _
ActiveConnection:=cn, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable

If .EOF <> True Then
.MoveLast
End If
End With


LastCol = sht.Cells(1, Columns.Count).End(xlToLeft).Column

LastRow = sht.Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
With rs
.AddNew
!ID = sht.Cells(RowCount, "A")
For ColCount = 2 To LastCol
If Data <> "" Then
ColName = sht.Cells(1, ColCount)

rs(ColName) = sht.Cells(RowCount, ColCount)
End If
Next ColCount
.Update
End With
Next RowCount


Set appAccess = Nothing
End Sub