From: Ajacoa on
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
con.Execute "INSERT INTO ... SELECT * FROM ..." 'Looping this for each

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?

Thank You!
From: joel on

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

You could export your spreadshet as CSV and then import the data into
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, _

If .EOF <> True Then
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
!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
End With
Next RowCount

Set appAccess = Nothing
End Sub

joel's Profile:
View this thread: