如何用VB通过代码,把Excel文件里数据导入到SQLserver?(谢谢,各位)

Question

首先,让用户通过Dialog,选择一个要导入的Excel文件,然后点击“确定”,就把此Excel文件的所有数据导入到SQLserver里去了,但本人从来没有做过此方面的工作,
所以恳请您指教,多谢！！！

Answer 1

看你的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

Answer 2

http://www.csdn.net/develop/read_article.asp?id=18623

Answer 3

实际上很简单
些一个存储过程,利用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调用这个存储过程就行了,稍微改一下就可以实现传参

Answer 4

SELECT * 
FROM OpenDataSource ( 'Microsoft.Jet.OLEDB.4.0',
  'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions

Answer 5

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

Answer 6

在Visual Basic 6.0 中，您可以通过ADO将和Excel对象将Excel中的内容添加到SQL Server中,您可以参考以下代码:Dim strSQL As StringDim cn As New Connectioncn.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 希望对您有所帮助。

Answer 7

4.用两个Ado分别连接xls和sqlserver，然后循环导入

Answer 8

例如：   
 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

Answer 9

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