Question

我是Vba的新手，希望有人能解决我的问题。我正在尝试更新电子表格中的数据。实际上我有20,000条记录，每条记录大约有74列。因此，使用ADO花费大量时间来记录更新记录。是否有任何替代方法可以单次更新这些记录。非常感谢任何帮助。

目前我的代码是。

    Sub InitialExport()
      On Error GoTo ErrHandler

    Dim con As New ADODB.Connection
    Dim Query As String
    Dim EffectedRecs As Long
    Dim i As Integer

    ServerName = "192.178.78.36"

    'Setting ConnectionString
    con.ConnectionString = "Provider=SQLOLEDB; " & _
            "Data Source=" & ServerName & "; " & _
            "Initial Catalog=AppEmp;" & _
            "User ID=sa; Password=admin08; "

    'Setting provider Name
    con.Provider = "Microsoft.JET.OLEDB.12.0"

    'Opening connection
    con.Open
    With ThisWorkbook.Sheets("Export")
    For i = 3 To ThisWorkbook.Sheets("Export").Range("B65536").End(xlUp).Row
        '---------------------->
        EmpId = .Range("B" & i).Value 'Emp Code-varchar
        C = .Range("C" & i).Value 'Emp Name-varchar
        D = .Range("D" & i).Value 
        E = .Range("E" & i).Value 
        F = .Range("F" & i).Value 
        G = .Range("G" & i).Value 
        H = .Range("H" & i).Value
        II = .Range("I" & i).Value 
        JJ = .Range("J" & i).Value 
        k = .Range("K" & i).Value 
        l = .Range("L" & i).Value 
        M = .Range("M" & i).Value 

        N = CheckNull(.Range("N" & i).Value)
        O = CheckNull(.Range("O" & i).Value) 
        P = CheckNull(.Range("P" & i).Value) 
        Q = CheckNull(.Range("Q" & i).Value) 
        R = CheckNull(.Range("R" & i).Value) 
        S = .Range("S" & i).Value 
        T = .Range("T" & i).Value 
        U = .Range("U" & i).Value 
        v = .Range("V" & i).Value 
        W = .Range("W" & i).Value
        X = CheckNull(.Range("X" & i).Value)

        Y = .Range("Y" & i).Value 
        Z = .Range("Z" & i).Value 
        AA = CheckNull(.Range("AA" & i).Value)
        AB = .Range("AB" & i).Value 
        AC = CheckNull(.Range("AC" & i).Value) 
        AD = CheckNull(.Range("AD" & i).Value) 
        AE = CheckNull(.Range("AE" & i).Value) 
        AF = CheckNull(.Range("AF" & i).Value)
        AG = .Range("AG" & i).Value 
        AH = CheckNull(.Range("AH" & i).Value) 
        AI = CheckNull(.Range("AI" & i).Value) 
        AJ = CheckNull(.Range("AJ" & i).Value) 
        AK = CheckNull(.Range("AK" & i).Value)
        AL = CheckNull(.Range("AL" & i).Value) 
        AM = CheckNull(.Range("AM" & i).Value)
        AN = CheckNull(.Range("AN" & i).Value) 
        AO = CheckNull(.Range("AO" & i).Value) 
        AP = CheckNull(.Range("AP" & i).Value) 
        AQ = CheckNull(.Range("AQ" & i).Value)
        AR = CheckNull(.Range("AR" & i).Value) 
        aAS = CheckNull(.Range("AS" & i).Value) 
        AT = .Range("AT" & i).Value
        AU = CheckNull(.Range("AU" & i).Value) 
        AV = CheckNull(.Range("AV" & i).Value) 
        AW = CheckNull(.Range("AW" & i).Value) 
        AX = CheckNull(.Range("AX" & i).Value) 
        AY = CheckNull(.Range("AY" & i).Value) 
        AZ = CheckNull(.Range("AZ" & i).Value) 
        BA = CheckNull(.Range("BA" & i).Value) 
        BB = CheckNull(.Range("BB" & i).Value)
        BC = CheckNull(.Range("BC" & i).Value) 
        BD = CheckNull(.Range("BD" & i).Value)
        BE = .Range("BE" & i).Value 

        BF = .Range("BF" & i).Value 
        BG = CheckNull(.Range("BG" & i).Value) 
        BH = .Range("BH" & i).Value 
        BI = .Range("BI" & i).Value 
        BJ = CheckNull(.Range("BJ" & i).Value) 
        BK = CheckNull(.Range("BK" & i).Value) 
        BL = CheckNull(.Range("BL" & i).Value) 
        BM = .Range("BM" & i).Value 
        BN = .Range("BN" & i).Value 



        Query = "Exec HRApp_P_AddEmpData '" & EmpId & "','" & C & "','" & D & "','" & E & "','" & F & "','" & G & "','" & H & "','" & II & "','" & JJ & "','" & k & "','" & l & "','" & M & "'," & N & "," & O & "," & P & "," & Q & "," & R & ",'" & S & "','" & T & "','" & U & "','" & v & "','" & W & "'," & X & ",'" & Y & "','" & Z & "'," & AA & ",'" & AB & "'," & AC & "," & AD & "," & AE & "," & AF & ",'" & AG & "'," & AH & "," & AI & "," & AJ & "," & AK & ",'" & AL & "'," & AM & "," & AN & "," & AO & "," & AP & "," & AQ & "," & AR & "," & aAS & ",'" & AT & "'," & AU & "," & AV & "," & AW & "," & AX & "," & AY & "," & AZ & "," & BA & "," & BB & "," & BC & "," & BD & ",'" & BE & "','" & BF & "'," & BG & ",'" & BH & "','" & BI & "'," & BJ & "," & BK & "," & BL & ",'" & BM & "','" & BN & "'"

        con.Execute Query

    Next
    End With

     con.Close
     Set con = Nothing
    Exit Sub
ErrHandler:     'MsgBox "The Not able ta Save Data"

                Set con = Nothing
End Sub

上面的代码工作正常。但它需要更多时间来更新数据。： - （

现在我的代码变成了这样的

  Private Sub Worksheet_Activate()
    Dim adoConn             As New ADODB.Connection
    Dim adoRS               As New ADODB.Recordset

    Dim sQuery              As String
    Dim EffectedRecs        As Long
    Dim sFields             As String
    Dim sValues             As String

    Dim iRow                As Integer
    Dim iField              As Integer

    ServerName = "193.128.125.14"
    con_Str = "Provider=SQLOLEDB; " & _
            "Data Source=" & ServerName & "; " & _
            "Initial Catalog=DB_At&T;" & _
            "User ID=sa; Password=ad28; "

    sQuery = "select * from Currency where 1=2"

    sValues = ""

    With adoConn
        .ConnectionString = con_Str
        .Provider = "Microsoft.JET.OLEDB.12.0"
        .CursorLocation = adUseClient
        .Open
    End With

    With adoRS
        .ActiveConnection = adoConn
        .CursorLocation = adUseClient
        .LockType = adLockBatchOptimistic
        .CursorType = adOpenKeyset ' adOpenDynamic
        .Source = sQuery
        .Open
    End With

    With ThisWorkbook.Sheets("Export")
        For iRow = 3 To ThisWorkbook.Sheets("Export").Range("B65536").End(xlUp).Row
            For iField = 0 To adoRS.Fields.Count - 1
                sFields = sFields & "," & adoRS.Fields(iField).Name
            Next

            sValues = sValues & "," & .Range("A" & iRow).Value
            sValues = sValues & "," & .Range("B" & iRow).Value
            sValues = sValues & "," & .Range("C" & iRow).Value
            sValues = sValues & "," & .Range("D" & iRow).Value

            sFields = Right(sFields, Len(sFields) - 1) 'Removing ,
            sValues = Right(sValues, Len(sValues) - 1) 'Removing ,
            adoRS.AddNew FieldList = sFields, Values:=sValues
        Next
End With

    adoRS.UpdateBatch adAffectAllChapters

    adoRS.Close
    adoConn.Close
End Sub

Answer 1

你可以试试这个：

Sub InitialExport()
On Error GoTo ErrHandler
'
Dim adoConn             As New ADODB.Connection
Dim adoRS               As ADODB.Recordset
'
Dim sQuery              As String
Dim EffectedRecs        As Long
Dim sFields             As String
Dim sValues             As String
'
Dim iRow                As Integer
Dim iField              As Integer
'
ServerName = SERVER_NAME
'
sQuery="SELECT * from tableName where 1 =2" ' get an empty recordset!
'
'Set the connection and open
with adoConn
    .ConnectionString = CONNECTION_STRING
    .Provider = "Microsoft.JET.OLEDB.12.0"
    .cursorlocation=aduseclient
    .Open
end with
'
' set the Recordset and open
With adoRS
    .activeconnection=adoconn
    .CursorLocation = adUseClient
    .LockType = adLockBatchOptimistic
    .CursorType = adopenkeyset ' adOpenDynamic
    .Source = sQuery
    .Open
End With
'
' now get the data into the recordset
With ThisWorkbook.Sheets("Export")
    For iRow = 3 To ThisWorkbook.Sheets("Export").Range("B65536").End(xlUp).Row
        ' here loop through all the columns
        For iField = 0 To adoRS.Fields.Count - 1
            ' adding the column names to the Variable sFields
            sFields = sFields & "," & adoRS.Fields(iField).Name
            '
            ' adding the values from the worksheet for this row
            sValues = sValues & ", " & .Cells(iRow, iField).Text
        Next
        '
        ' add a new record with the fields and values
        adoRS.AddNew FieldList:=sFields, Values:=sValues
        '
Next
'
' update all the rows in one step
adoRS.UpdateBatch adAffectAllChapters ' update them all in one step!
'
End Sub

只需将查询中的 tablename 更改为正确的表，并确保工作表中的列与表中的列具有相同的顺序和数据类型

对于ADO Recordset帮助，请参阅：

MSDN Library - ADO Recordset, AddNew method

和

MSDN Library - ADO Recordset, UpdateBatch

和

W3Schools

我希望你开始了！

菲利普

Answer 2

另一个选项是使用BulkInsert将整个Excel表格作为csv文件直接上传到服务器。

Sql代码可能看起来很简单：

BULK INSERT [DB].[dbo].[Importa_Aux] FROM '\\share\filename.csv' WITH ( FIELDTERMINATOR = ',' , ROWTERMINATOR = '\n' , FIRSTROW = 2 )

然后只需在SqlServer中处理数据更新。

如何将电子表格数据导出到SQLServer？

2 个答案: