如何将电子表格数据导出到SQLServer？ [英] How to export spreadsheet data into SQLServer?
本文介绍了如何将电子表格数据导出到SQLServer？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
目前我的代码是。
Sub InitialExport（）
错误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
'设置ConnectionString
con.ConnectionString =Provider = SQLOLEDB;& _
Data Source =& ServerName& ;& _
初始目录= AppEmp; &安培; _
User ID = sa; Password = admin08;
'设置提供者名称
con.Provider =Microsoft.JET.OLEDB.12.0
'打开连接
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范围（Q& i）.Value）
R = CheckNull（.Range（R& i）.Value）
S = .Range（S& i）值
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& ）.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 & 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 & 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范围（AY& i）.Value）
AZ = CheckNull（.Range（AZ& i）.Value）
BA = CheckNull（.Range（BA& i ）
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 & i）.Value
BG = CheckNull（.Range（BG& i）.V alue）
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& ）.Value
BN = .Range（BN& i）.Value
Query =Exec HRApp_P_AddEmpData'& EmpId& ，& C& ，& D& ，& E& ，& F& ，& G& ，& H& ，& II& ，& JJ& ，& k& ，& l& ，&并购，& N& ，& O& ，& P& ，&问答，&研发，& S& ，& T& ，& U& ，& v& ，& W& ，& X& ，& Y& ，& Z& ，& AA& ，& AB& ，&交流& ，& AD& ，& AE& ，& AF& ，& AG& ，& AH& ，&人与人，& AJ& ，& AK& ，&一盏灯; ，& 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查询
下一个
结束
con.Close
设置con = Nothing
退出Sub
ErrHandler：'MsgBox不能保存数据$ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $
上面的代码正常工作。但是更新数据需要更多的时间： - （
现在我的代码变成这样了
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;& _
数据源=& __
初始目录= DB_At& T& _
用户ID = sa;密码= ad28;
sQuery =select * from Currency where 1 = 2
sValues =
With adoConn
.ConnectionString = con_Str
.Provider =Microsoft.JET.OLEDB.12.0
.CursorLocation = adUseClient
.Open
结束
带有adoRS
.ActiveConnection = adoConn
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.CursorType = adOpenKeyset'adOpenDynamic
.Source = sQuery
.Open
结束
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
下一个
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）'删除，
sValues = Right（sValues，Len（sValues） - 1）'删除，
adoRS.AddNew FieldList = sFields，值：= sValues
下一个
结束
adoRS.UpdateBatch adAffectAllChapters
adoRS.Close
adoConn.Close
End Sub
解决方案
你可以尝试这样：
Sub InitialExport（）
错误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其中1 = 2'得到一个空的记录集！
'
'设置连接并使用adoConn
打开
.ConnectionString = CONNECTION_STRING
.Provider =Microsoft.JET.OLEDB.12.0
。 cursorloc = aduseclient
.Open
end with
'
'设置Recordset并打开
with adoRS
.activeconnection = adoconn
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.CursorType = adopenkeyset'adOpenDynamic
.Source = sQuery
.Open
结束
'
'现在将数据存入记录集
WithWorkbook.Sheets（Export）
对于iRow = 3 To ThisWorkbook.Sheets（Export）。Range（B65536）。End（xlUp）。 Row
'这里循环遍历所有列
对于iField = 0 To adoRS.Fields.Count - 1
'将列名称添加到Variable sFields
sFields = sFields& ，& adoRS.Fields（iField）.Name
'
'从此行的工作表中添加值
sValues = sValues& ，& .Cells（iRow，iField）.Text
下一个
'
'添加一个带有字段和值的新记录
adoRS.AddNew FieldList：= sFields，Values：= sValues
'
下一个
'
'更新一步中的所有行
adoRS.UpdateBatch adAffectAllChapters'一步更新！
'
End Sub
只需更改 tablename 在查询到正确的表格中，并确保工作表中的列与ADO Recordset中的表
中的列具有相同的顺序和数据类型，请参见： / p>
MSDN库 - ADO Recordset，AddNew方法
和
和
Philip
I am new to Vba, hope someone will solve my problem. I am trying to update data present in my spreadsheet. Actually i have 20,000 records, each record has around 74 columns. So updating them record by record by using ADO taking so much of time. Is there any alternative approach to update those records in single shot. Any help would be appreciated greatly.
Currently my code is.
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
The above code is working fine. But it is taking more time to update data.:-(
Now my code became like this
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
解决方案
you could try this:
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
just change tablename in the query to the correct table and make sure the columns in the worksheet are in the same order and datatype as the columns in the table
for ADO Recordset help see:
MSDN Library - ADO Recordset, AddNew method
and
MSDN Library - ADO Recordset, UpdateBatch
and
I hope that get's you started!
Philip
这篇关于如何将电子表格数据导出到SQLServer？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
