如何将电子表格数据导出到SQLServer？
我是VBA新手，希望有人能解决我的问题。 我正在尝试更新电子表格中的数据。 其实我有2万条logging，每条logging大约有74列。 所以更新他们logging通过使用ADOlogging这么多时间。 有没有其他的方法来更新这些logging单枪。 任何帮助将不胜感激。
目前我的代码是。
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
你可以试试这个：
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
只要将查询中的表名更改为正确的表，并确保工作表中的列与表中的列的顺序和数据types相同
为ADOlogging集帮助请参阅：
MSDN Library – ADO Recordset，AddNew方法
和
MSDN库 – ADOlogging集，UpdateBatch
和
W3Schools的
我希望得到你的开始！
菲利普
另一种select是使用BulkInsert将整个Excel工作表作为csv文件直接上传到服务器。
Sql代码可能看起来像这样简单：
BULK INSERT [DB].[dbo].[Importa_Aux] FROM '\\share\filename.csv' WITH ( FIELDTERMINATOR = ',' , ROWTERMINATOR = '\n' , FIRSTROW = 2 )
然后只需在SqlServer中处理数据更新。