EXCEL页面数据快速写入SQL数据库

将EXCEL数据存入SQL表, 一万行记录大概5秒

Dim conn As New ADODB.Connection
Dim CNN As New ADODB.Connection
'Dim rst As New ADODB.Recordset

Dim Sql As String
Dim j, v As Integer


Const cnnstr = "Provider = SQLOLEDB;" & _
"Data Source = ip;" & _
"Initial Catalog = apsdb;User ID =sa;Password = pw;"
conn.Open cnnstr
conn.Execute "truncate table tjnpg"

Application.EnableEvents = False
On Error GoTo ErrHandle

j = ActiveSheet.Range("A65535").End(xlUp).Row

v = Application.Version

If v = 11 Then 'EXCEL2003
CNN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
Else
CNN.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=excel 12.0;Data Source=" & ThisWorkbook.FullName
End If

' Sql = "select 部门,交期,产品号,生产订单号,旧物料号,物料描述 from [Sheet1$]"
' rst.Open Sql, CNN, adOpenKeyset, adLockOptimistic
' Debug.Print rst.RecordCount


Sql = "INSERT INTO [odbc;Driver={SQL Server};" & _
"Server=ip;Database=apsdb;" & _
"UID=sa;PWD=pw].tjnpg " & _
"select 部门,交期,产品号,生产订单号,旧物料号,物料描述 from [Sheet1$]"

CNN.Execute Sql

MsgBox "存入成功.", vbInformation, "诚益资讯"



'关闭数据连接
CNN.Close
Set rst = Nothing
Set CNN = Nothing

conn.Close
Set conn = Nothing

GoTo ExitHandle

ExitHandle:
Application.EnableEvents = True
Exit Sub
ErrHandle:
Application.EnableEvents = True
MsgBox Err.Description, vbCritical, "诚益资讯"