Excel表数据批量上传SQL Server

jygzcj

Sub UpdateTable()
   
    On Error GoTo Errhandle
   
    Dim objfl As Variant
   
    Dim rngName As Range
   
    Dim LastRow As Long
   
   
    With Sheet1
        If .FilterMode Then
            .ShowAllData
        End If
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        
        Set rngName = .Range(.Cells(1, 1), .Cells(LastRow, 16))
    End With
   
    rngName.Name = "TempRange"
   
    Dim strFileName As String
   
   
    strFileName = ThisWorkbook.FullName
   
    Dim cnn As Object
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes"";"
   
    Dim nSQL As String
    Dim nJoin As String
   
    nSQL = "INSERT INTO [odbc;Driver={SQL Server};UID=consign_user;DataBase=consign;PWD=#202308;Server=10.125.4.33].[CheryReconcileRecord]"
    nJoin = " SELECT * from [TempRange]"
   
    cnn.begintrans
   
    cnn.Execute nSQL & nJoin
   
    cnn.Committrans
   
    MsgBox "数据已经批量更新成功", vbInformation
   
    Exit Sub
   
   
Errhandle:

    cnn.rollbacktrans
    MsgBox "数据更新出错,未更新成功" & Err.Description, vbInformation
   
   
   
        
End Sub

opiona

https://club.excelhome.net/thread-1666858-1-1.html