我正在使用以下 VBA 代码将 Excel 工作表中的范围导出到 SQL Server 表 ( original source here )
Function ExportRangeToSQL(sourceRange As Range, conString As String, tableName As String) As Integer
On Error Resume Next
Dim con As Object
Set con = CreateObject("ADODB.Connection")
con.ConnectionString = conString
con.Open
Dim cmd As Object
Set cmd = CreateObject("ADODB.Command")
' Do work within Transaction:'
Dim level As Long
level = con.BeginTrans
cmd.CommandType = 1 ' adCmdText'
Dim rst As Object
Set rst = CreateObject("ADODB.Recordset")
With rst
' Get Column Mapping Information from DB:'
Set .ActiveConnection = con
.Source = "SELECT TOP 1 * FROM " & tableName
.CursorLocation = 3 ' adUseClient'
.LockType = 4 ' adLockBatchOptimistic'
.CursorType = 0 ' adOpenForwardOnly'
.Open
' Column mappings'
Dim tableFields(100) As Integer
Dim rangeFields(100) As Integer
Dim exportFieldsCount As Integer
exportFieldsCount = 0
Dim col As Integer
Dim index As Integer
' Map range Columns to DB Columns:'
For col = 0 To .Fields.Count - 1
index = Application.Match(.Fields(col).Name, sourceRange.Rows(1), 0)
If index > 0 Then
exportFieldsCount = exportFieldsCount + 1
tableFields(exportFieldsCount) = col
rangeFields(exportFieldsCount) = index
End If
Next
If exportFieldsCount = 0 Then
ExportRangeToSQL = 1
GoTo ConnectionEnd
End If
' Load the Range into the Recordset:'
Dim arr As Variant
arr = sourceRange.Value
Dim row As Long
Dim rowCount As Long
rowCount = UBound(arr, 1)
Dim val As Variant
For row = 2 To rowCount
.AddNew
For col = 1 To exportFieldsCount
val = arr(row, rangeFields(col))
If IsEmpty(val) Then
Else
.Fields(tableFields(col)) = val
End If
Next
Next
' Update the table using the same RecordSet:'
.UpdateBatch
End With
rst.Close
Set rst = Nothing
ExportRangeToSQL = 0
ConnectionEnd:
con.CommitTrans
con.Close
Set cmd = Nothing
Set con = Nothing
End Function
基本上,它:
- 根据我们希望更新的表创建记录集
- 将更新范围的每一列映射到记录集中的字段
- 使用要上传的数据更新记录集
- 使用
Recordset.UpdateBatch
一次性更新表格。
不过,我发现这速度慢得令人难以置信(对于 1000-2000 条记录),并且编写单独的插入语句要快得多(尽管不是那么漂亮)。
关于如何加快速度有什么想法吗?
最佳答案
请更改这行代码:
.CursorType = 0 ' adOpenForwardOnly'
到
.CursorType = 4 ' adOpenStatic - could also use adOpenKeyset
因为您的游标类型未针对更新操作进行优化。
关于sql-server - Excel VBA - SQL Server 表更新缓慢,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/32567556/