'当然,你也可以定义两个连接分别到sqlserver与excel文件,然后定义两个纪录集打开对应的表,你就可以相互赋值从而达到导入的目的,这种速度会慢些,优点是excel文件不需要存在同一个电脑上(上述方法需要)
'引用Microsoft Activex Data Object2.x Library 与 Microsoft Excel Object9.0(或以上) Library
Dim cnSqlserver As ADODB.Connection
Dim cnExcel As ADODB.Connection
Dim rsExcel As ADODB.Recordset
Dim rsSqlserver As ADODB.Recordset
Set cnExcel = New ADODB.Connection
cnExcel.CursorLocation = adUseClient
'连接到Excel
cnExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\test.xls;Extended Properties=Excel 8.0;Persist Security Info=true"
Set cnSqlserver = New ADODB.Connection
cnSqlserver.CursorLocation = adUseClient
'连接到Sqlserver
cnSqlserver.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\test.xls;Extended Properties=Excel 8.0;Persist Security Info=true"
Set rsExcel = New ADODB.Recordset
'打开Excel中的源表
rsExcel.Open "table1", cnExcel, adOpenKeyset, adLockOptimistic
Set rsSqlserver = New ADODB.Recordset
'打开Sqlserver的目的表
rsSqlserver.Open "select * from table2 where 1=2", cnSqlserver, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not rsExcel.EOF
'将源表中的纪录赋给目的表
rsSqlserver.AddNew
rsSqlserver!ID = rsExcel!ID
rsSqlserver!Name = rsExcel!Name
'...
'...
'...
rsSqlserver.Update
rsExcel.MoveNext
Loop
rsExcel.Close
rsSqlserver.Close
Set rsExcel = Nothing
Set rsSqlserver = Nothing
cnExcel.Close
cnSqlserver.Close
Set cnExcel = Nothing
Set cnSqlserver = Nothing
'当然,你也可以定义两个连接分别到sqlserver与excel文件,然后定义两个纪录集打开对应的表,你就可以相互赋值从而达到导入的目的,这种速度会慢些,优点是excel文件不需要存在同一个电脑上(上述方法需要)
'引用Microsoft Activex Data Object2.x Library 与 Microsoft Excel Object9.0(或以上) Library
Dim cnSqlserver As ADODB.Connection
Dim cnExcel As ADODB.Connection
Dim rsExcel As ADODB.Recordset
Dim rsSqlserver As ADODB.Recordset
Set cnExcel = New ADODB.Connection
cnExcel.CursorLocation = adUseClient
'连接到Excel
cnExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\test.xls;Extended Properties=Excel 8.0;Persist Security Info=true"
Set cnSqlserver = New ADODB.Connection
cnSqlserver.CursorLocation = adUseClient
'连接到Sqlserver
cnSqlserver.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\test.xls;Extended Properties=Excel 8.0;Persist Security Info=true"
Set rsExcel = New ADODB.Recordset
'打开Excel中的源表
rsExcel.Open "table1", cnExcel, adOpenKeyset, adLockOptimistic
Set rsSqlserver = New ADODB.Recordset
'打开Sqlserver的目的表
rsSqlserver.Open "select * from table2 where 1=2", cnSqlserver, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not rsExcel.EOF
'将源表中的纪录赋给目的表
rsSqlserver.AddNew
rsSqlserver!ID = rsExcel!ID
rsSqlserver!Name = rsExcel!Name
'...
'...
'...
rsSqlserver.Update
rsExcel.MoveNext
Loop
rsExcel.Close
rsSqlserver.Close
Set rsExcel = Nothing
Set rsSqlserver = Nothing
cnExcel.Close
cnSqlserver.Close
Set cnExcel = Nothing
Set cnSqlserver = Nothing
全部程序:
Private Sub subIncome()
Dim rs As New ADODB.Recordset
Dim str1 As String
Dim getrow As Integer
Dim TExcel As Excel.Application
If Text1.Text <> "" Then
Set TExcel = CreateObject("excel.application")
TExcel.Workbooks.Open (Cd.FileName)'Cd为CommonDialog
rs.Open "select * from 数据库表名", gConnforSQL, adOpenKeyset, adLockOptimistic
Dim str As String
Dim j As Integer
getrow = TExcel.Worksheets(1).UsedRange.Rows.Count'得到的行数
With rs
For j = 1 To getrow
.AddNew
.Fields("数据库中的字段") = CInt(TExcel.Sheets(1).Cells(j, 1).Value)
.Update
Next
End With
rs.Close
TExcel.Workbooks.Close
TExcel.Quit'这句最重要否则不退出vb程序不能在Windows中打开excel
Else
MsgBox "请输入要导入的excel文件", vbOKOnly, "系统提示"
Cmdview.SetFocus
End If