1,216
社区成员
发帖
与我相关
我的任务
分享如何用VB通过代码,把Excel文件里数据导入到SQLserver?(谢谢,各位)
首先,让用户通过Dialog,选择一个要导入的Excel文件,然后点击“确定”,就把此Excel文件的所有数据导入到SQLserver里去了,但本人从来没有做过此方面的工作,
所以恳请您指教,多谢！！！
所以恳请您指教,多谢！！！
...全文
请发表友善的回复…
发表回复
yoki 2003-09-12
- 打赏
- 举报
例如：
Dim cnFrom As New ADODB.Connection
Dim cnTo As New ADODB.Connection
Dim rsFrom As New ADODB.Recordset
Dim rsTo As New ADODB.Recordset
Dim rsTablesInExcel As New ADODB.Recordset
Dim strArryTableNameInExcel() As String
Dim intCounts As Integer
Dim intMaxArry As Integer
'连接Excel
cnFrom.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\source.xls;Extended Properties=Excel 8.0;Persist Security Info=False"
'连接SqlServer
cnTo.Open "DRIVER={SQL SERVER};SERVER=ServerName;Uid=sa;Pwd=Password;database=DatabaseName"
'得到打开的Excel文件中的用户表、存入数组
Set rsTablesInExcel = cnSource.OpenSchema(adSchemaTables)
If Not rsTablesInExcel.EOF Then
ReDim strArryTableNameInExcel(0)
For intCounts = 0 To rsTablesInExcel.RecordCount - 1
If UCase(rsTablesInExcel!TABLE_TYPE) = "TABLE" Then
intMaxArry = intMaxArry + 1
ReDim Preserve strArryTableNameInExcel(intMaxArry)
strArryTableNameInExcel(intMaxArry) = rsTablesInExcel!TABLE_NAME
End If
rsTablesInExcel.MoveNext
Next intCounts
End If
rsTablesInExcel.Close
Set rsTablesInExcel = Nothing
'循环到入打开的表
For intCounts = 1 To UBound(strArryTableNameInExcel)
rsFrom.Open "select * from [" & strArryTableNameInExcel(intCounts) & "]", cnFrom
rsTo.Open "select * from 目的表 where 1=2", cnTo
Do While Not rsFrom.EOF
rsTo.AddNew
rsTo.Fields(0) = rsFrom.Fields(0)
'.....各字段映射
rsTo.Update
Loop
rsFrom.Close
rsTo.Close
Next intCounts
Set rsFrom = Nothing
Set rsTo = Nothing
cnFrom.Close
cnTo.Close
Set cnFrom = Nothing
Set cnTo = Nothing
Dim cnFrom As New ADODB.Connection
Dim cnTo As New ADODB.Connection
Dim rsFrom As New ADODB.Recordset
Dim rsTo As New ADODB.Recordset
Dim rsTablesInExcel As New ADODB.Recordset
Dim strArryTableNameInExcel() As String
Dim intCounts As Integer
Dim intMaxArry As Integer
'连接Excel
cnFrom.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\source.xls;Extended Properties=Excel 8.0;Persist Security Info=False"
'连接SqlServer
cnTo.Open "DRIVER={SQL SERVER};SERVER=ServerName;Uid=sa;Pwd=Password;database=DatabaseName"
'得到打开的Excel文件中的用户表、存入数组
Set rsTablesInExcel = cnSource.OpenSchema(adSchemaTables)
If Not rsTablesInExcel.EOF Then
ReDim strArryTableNameInExcel(0)
For intCounts = 0 To rsTablesInExcel.RecordCount - 1
If UCase(rsTablesInExcel!TABLE_TYPE) = "TABLE" Then
intMaxArry = intMaxArry + 1
ReDim Preserve strArryTableNameInExcel(intMaxArry)
strArryTableNameInExcel(intMaxArry) = rsTablesInExcel!TABLE_NAME
End If
rsTablesInExcel.MoveNext
Next intCounts
End If
rsTablesInExcel.Close
Set rsTablesInExcel = Nothing
'循环到入打开的表
For intCounts = 1 To UBound(strArryTableNameInExcel)
rsFrom.Open "select * from [" & strArryTableNameInExcel(intCounts) & "]", cnFrom
rsTo.Open "select * from 目的表 where 1=2", cnTo
Do While Not rsFrom.EOF
rsTo.AddNew
rsTo.Fields(0) = rsFrom.Fields(0)
'.....各字段映射
rsTo.Update
Loop
rsFrom.Close
rsTo.Close
Next intCounts
Set rsFrom = Nothing
Set rsTo = Nothing
cnFrom.Close
cnTo.Close
Set cnFrom = Nothing
Set cnTo = Nothing
yoki 2003-09-12
- 打赏
- 举报
4.用两个Ado分别连接xls和sqlserver，然后循环导入
lihonggen0 2003-09-12
- 打赏
- 举报
在Visual Basic 6.0 中，您可以通过ADO将和Excel对象将Excel中的内容添加到SQL Server中,您可以参考以下代码:
Dim strSQL As String
Dim cn As New Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=c:\test.xls;Extended Properties=Excel 8.0"
’如果这张表不存在，你可以使用如下代码：
strSQL = "SELECT * INTO [odbc;Driver={SQL Server};Server=sha-kennyhao-01;Database=Northwind;UID=sa;PWD=;].Customers2 FROM [Sheet1$]"
cn.Execute strSQL, , adExecuteNoRecords
如果表已经存在，您需要添加进数据库，可以使用如下代码：
strSQL = "INSERT INTO [odbc;Driver={SQL Server};Server=sha-kennyhao-01;Database=Northwind;UID=sa;PWD=;].Customers2 SELECT * FROM [Sheet1$]"cn.Execute strSQL, , adExecuteNoRecords
您可以参考以下几篇文章，他们介绍了如何将数据从SQL Server导入到Excel中，并且介绍了Select Into…From table和Insert into… Select * from table的使用。
HOWTO: Transfer Data from ADO Data Source to Excel with ADO (Q295646)
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q295646
以及
HOW TO: Import Data from Microsoft SQL Server into Microsoft Excel (Q306125)
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q306125
希望对您有所帮助。
Dim strSQL As String
Dim cn As New Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=c:\test.xls;Extended Properties=Excel 8.0"
’如果这张表不存在，你可以使用如下代码：
strSQL = "SELECT * INTO [odbc;Driver={SQL Server};Server=sha-kennyhao-01;Database=Northwind;UID=sa;PWD=;].Customers2 FROM [Sheet1$]"
cn.Execute strSQL, , adExecuteNoRecords
如果表已经存在，您需要添加进数据库，可以使用如下代码：
strSQL = "INSERT INTO [odbc;Driver={SQL Server};Server=sha-kennyhao-01;Database=Northwind;UID=sa;PWD=;].Customers2 SELECT * FROM [Sheet1$]"cn.Execute strSQL, , adExecuteNoRecords
您可以参考以下几篇文章，他们介绍了如何将数据从SQL Server导入到Excel中，并且介绍了Select Into…From table和Insert into… Select * from table的使用。
HOWTO: Transfer Data from ADO Data Source to Excel with ADO (Q295646)
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q295646
以及
HOW TO: Import Data from Microsoft SQL Server into Microsoft Excel (Q306125)
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q306125
希望对您有所帮助。
yoki 2003-09-12
- 打赏
- 举报
1.DTS向导
2.BCP
EXEC master..xp_cmdshell 'bcp test.dbo.P_Aspect in c:\temp1.xls -c -q -S"servername" -U"sa" -P""'
3.行集函数
SELECT *
FROM OpenDataSource ( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions
2.BCP
EXEC master..xp_cmdshell 'bcp test.dbo.P_Aspect in c:\temp1.xls -c -q -S"servername" -U"sa" -P""'
3.行集函数
SELECT *
FROM OpenDataSource ( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions
PennyMac 2003-09-12
- 打赏
- 举报
SELECT *
FROM OpenDataSource ( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions
FROM OpenDataSource ( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions
yijiansong 2003-09-12
- 打赏
- 举报
好帖子一定要顶
又学到不少
楼主一定给我分
虽然我是来学习的
又学到不少
楼主一定给我分
虽然我是来学习的
xinshou1979330 2003-09-12
- 打赏
- 举报
好帖子一定要顶
又学到不少
楼主不用给我分
我是来学习的
又学到不少
楼主不用给我分
我是来学习的
astroboy 2003-09-12
- 打赏
- 举报
Dim excel_app As Object
Dim excel_sheet As Object
Dim rs As ADODB.Recordset
Dim strsql As String
Dim pubconn As ADODB.Connection
Dim exfieldA As String
Dim exfieldB As String
Dim exfieldC As String
Dim exfieldD As String
'打开数据库
Set rs = New ADODB.Recordset
Set pubconn = New ADODB.Connection
pubconn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=aaa;Data Source=(local)"
pubconn.Open
Set excel_app = CreateObject("excel.application") 'excel对象
Set excel_app = New Excel.Application
excel_app.Workbooks.Open FileName:="D:\***.xls"
If Val(excel_app.Application.Version) >= 8 Then '检查excel文件的版本
Set excel_sheet = excel_app.ActiveSheet
Else
Set excel_sheet = excel_app
End If
'''创建sql表格
Dim crtstrsql As String
Dim exceltst As String
exceltst = Text1.Text
exfieldA = Trim$(excel_sheet.Cells(1, 1))
exfieldB = Trim$(excel_sheet.Cells(1, 2))
exfieldC = Trim$(excel_sheet.Cells(1, 3))
exfieldD = Trim$(excel_sheet.Cells(1, 4))
crtstrsql = ""
crtstrsql = crtstrsql & "create table " & exceltst & "(" & vbCrLf
crtstrsql = crtstrsql & exfieldA & " char(50) null," & vbCrLf
crtstrsql = crtstrsql & exfieldB & " char(6) null," & vbCrLf
crtstrsql = crtstrsql & exfieldC & " datetime null," & vbCrLf
crtstrsql = crtstrsql & exfieldD & " datetime null)"
pubconn.Execute crtstrsql
Dim new_value1 As String
Dim new_value2 As String
Dim new_value3 As String
Row = 2
Do
new_value = Trim$(excel_sheet.Cells(Row, 1)) '读取excel工作者第一列数据
new_value1 = Trim$(excel_sheet.Cells(Row, 2))
If excel_sheet.Cells(Row, 3) = "" Then
new_value2 = ""
Else
new_value2 = CDate(excel_sheet.Cells(Row, 3) & "1月")
End If
If excel_sheet.Cells(Row, 4) = "" Then
new_value3 = ""
Else
new_value3 = CDate(excel_sheet.Cells(Row, 4) & "1月")
End If
If Len(new_value) = 0 And Len(new_value1) = 0 Then Exit Do
'将这一值插入SQL数据库
strsql = "insert into " & exceltst & "(" & exfieldA & "," & exfieldB & "," & exfieldC & "," & exfieldD & ") values('" & new_value & "','" & new_value1 & "','" & new_value2 & "','" & new_value3 & "')"
pubconn.Execute strsql
Row = Row + 1 '读取下一行数据
Loop
MsgBox "传输数据完成！", vbOKOnly, "完成！"
pubconn.Close
excel_app.Quit
Set rs = Nothing
Set pubconn = Nothing
Set excel_app = Nothing
Set excel_sheet = Nothing
Dim excel_sheet As Object
Dim rs As ADODB.Recordset
Dim strsql As String
Dim pubconn As ADODB.Connection
Dim exfieldA As String
Dim exfieldB As String
Dim exfieldC As String
Dim exfieldD As String
'打开数据库
Set rs = New ADODB.Recordset
Set pubconn = New ADODB.Connection
pubconn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=aaa;Data Source=(local)"
pubconn.Open
Set excel_app = CreateObject("excel.application") 'excel对象
Set excel_app = New Excel.Application
excel_app.Workbooks.Open FileName:="D:\***.xls"
If Val(excel_app.Application.Version) >= 8 Then '检查excel文件的版本
Set excel_sheet = excel_app.ActiveSheet
Else
Set excel_sheet = excel_app
End If
'''创建sql表格
Dim crtstrsql As String
Dim exceltst As String
exceltst = Text1.Text
exfieldA = Trim$(excel_sheet.Cells(1, 1))
exfieldB = Trim$(excel_sheet.Cells(1, 2))
exfieldC = Trim$(excel_sheet.Cells(1, 3))
exfieldD = Trim$(excel_sheet.Cells(1, 4))
crtstrsql = ""
crtstrsql = crtstrsql & "create table " & exceltst & "(" & vbCrLf
crtstrsql = crtstrsql & exfieldA & " char(50) null," & vbCrLf
crtstrsql = crtstrsql & exfieldB & " char(6) null," & vbCrLf
crtstrsql = crtstrsql & exfieldC & " datetime null," & vbCrLf
crtstrsql = crtstrsql & exfieldD & " datetime null)"
pubconn.Execute crtstrsql
Dim new_value1 As String
Dim new_value2 As String
Dim new_value3 As String
Row = 2
Do
new_value = Trim$(excel_sheet.Cells(Row, 1)) '读取excel工作者第一列数据
new_value1 = Trim$(excel_sheet.Cells(Row, 2))
If excel_sheet.Cells(Row, 3) = "" Then
new_value2 = ""
Else
new_value2 = CDate(excel_sheet.Cells(Row, 3) & "1月")
End If
If excel_sheet.Cells(Row, 4) = "" Then
new_value3 = ""
Else
new_value3 = CDate(excel_sheet.Cells(Row, 4) & "1月")
End If
If Len(new_value) = 0 And Len(new_value1) = 0 Then Exit Do
'将这一值插入SQL数据库
strsql = "insert into " & exceltst & "(" & exfieldA & "," & exfieldB & "," & exfieldC & "," & exfieldD & ") values('" & new_value & "','" & new_value1 & "','" & new_value2 & "','" & new_value3 & "')"
pubconn.Execute strsql
Row = Row + 1 '读取下一行数据
Loop
MsgBox "传输数据完成！", vbOKOnly, "完成！"
pubconn.Close
excel_app.Quit
Set rs = Nothing
Set pubconn = Nothing
Set excel_app = Nothing
Set excel_sheet = Nothing
superhuan 2003-08-13
- 打赏
- 举报
up
自由之眼 2003-08-13
- 打赏
- 举报
实际上很简单
些一个存储过程,利用DTS机制
例如:
insert into TableName
SELECT *
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...sheet1
然后使用VB调用这个存储过程就行了,稍微改一下就可以实现传参
些一个存储过程,利用DTS机制
例如:
insert into TableName
SELECT *
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...sheet1
然后使用VB调用这个存储过程就行了,稍微改一下就可以实现传参
lihonggen0 2003-08-13
- 打赏
- 举报
http://www.csdn.net/develop/read_article.asp?id=18623
TechnoFantasy 2003-08-13
- 打赏
- 举报
看你的Excel表数据是否规则。如果不的话，需要使用自动化的方法将excel文件打开，将里面的数据一条条取出来，然后插入SQL Server相应的表的相应的字段中。
如果比较规整的话，可以通过ADO来直接读取excel表：
http://support.microsoft.com/default.aspx?scid=http://support.microsoft.com:80/support/kb/articles/Q278/9/73.asp&NoWebContent=1
如果比较规整的话，可以通过ADO来直接读取excel表：
http://support.microsoft.com/default.aspx?scid=http://support.microsoft.com:80/support/kb/articles/Q278/9/73.asp&NoWebContent=1
