在vb中，将excel数据导入到数据库(SQL)中。

Question

我会设计一个公共对话框，    With CommonDialog1
        .FileName = "*.xls"
        .DialogTitle = "Select Excel file to open"
        .Filter = "Excel files|(*.xls)"
        .FilterIndex = 0
        .InitDir = App.Path
        .Flags = cdlOFNHideReadOnly
        .ShowOpen
        If .FileName = "*.xls" Then Exit Sub
    End With得到Excel文件后，怎么样把Execl数据导入到数据库中？
比如说：
有Materical.xls中有结构如下：
物料代码  物料名称  数量
A.A001    A货        1
B.B001    B货        1
C.C001    C货        1
我在SQL有张表Table，表结构如下：
FNumber  FName FStatus
我现在应该怎么把Materical中的“物料代码”数据对应的给Table中的“FNumber”，“物料名称”数据对应的给“FName” ?

Answer 1

Private Sub Command1_Click()
    Dim cn As ADODB.Connection    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\f1.xls;Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"    cn.Execute "Insert Into [;database=" & App.Path & "\mydb2.mdb].[f2](id,item1,item2)   Select id,item1,item2 From [Sheet1$]"    cn.Close
    Set cn = Nothing
End Sub

Answer 2

'先打开EXCEL，得到EXCEL内容
 Dim con As New OleDb.OleDbConnection("provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & Maintext.Text)
  ’Maintext.Text 为EXCEL的路径
            con.Open()
            Dim cmd As New OleDb.OleDbCommand("select * from [sheet1]", con)
            Dim adapter As OleDb.OleDbDataAdapter = New OleDb.OleDbDataAdapter(cmd)
            Dim DS As New DataSet
            Try
                adapter.Fill(DS, "DS")
            Catch EX As Exception
                MsgBox(EX.ToString, MsgBoxStyle.Critical)
                Exit Sub
            End Try
‘下面再把EXCEL中的内容插入数据库
         Dim UF As New System.Text.StringBuilder
        DIM I AS INTEGER
                Try
             FOR I =0 TO DS.TABLES(0).ROWS.COUNT -1
                    UF.Append(" INSERT INTO table( ")
                    UF.Append(" FNumber  ,")
                    UF.Append(" FName ,")
                    UF.Append(" FStatus） ")                    
                    UF.Append(" VALUES( ")
                    UF.Append(" '").Append(DS.TABLES(0).ROWS(I).ITEM(0)).Append("',  ")
UF.Append(" '").Append(DS.TABLES(0).ROWS(I).ITEM(1)).Append("',  ")
UF.Append(" '").Append(DS.TABLES(0).ROWS(I).ITEM(2)).Append("')  ")                   
                    Debug.WriteLine("")
                    Debug.WriteLine(UF.ToString)                    UFselect = New SqlClient.SqlCommand(UF.ToString, CNUF)
                    UFselect.CommandTimeout = 300
                    UFselect.ExecuteNonQuery()
                Catch ex As Exception
                    MsgBox(ex.Message, MsgBoxStyle.Critical, "用友Error")
                    Exit Sub
                End Try              NEXT                
以上仅供参考，没有完全重新写，部分修改而已，功能已经具备了

Answer 3

Private Sub Command1_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim cn1 As New ADODB.Connection
        
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Materical.xls;Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
    Set rs = cn.Execute("Select id,item1,item2 From [Sheet1$]")
    cn1.Open "Provider=SQLOLEDB.1;Password=dg;Persist Security Info=True;User ID=sa;Initial Catalog=pubs;Data Source=."
         
    Do While Not rs.EOF
       cn1.Execute ("Insert Into t1(FNumber,FName,FStatus) VALUES ('" & Format(rs(0)) & "','" & Format(rs(1)) & "','" & Format(rs(2)) & "')")
       rs.MoveNext
   Loop
   rs.Close: cn.Close: cn1.Close
   Set rs = Nothing: Set cn = Nothing: Set cn1 = Nothing
End Sub