VBA execl将数据导入数据库

Sub 把Excel数据插入数据库中()

'*******************************************

'时间：2010-06-28

'作者：bengdeng

'功能：把当前工作表的数据增加到在程序文件同一目录下进销存表数据库中

'注意：要在工具/引用中引用microsoft activex date objects x.x

' 其中x.x为版本号，可能会因为你安装的office的版本不同而不同，本例引用了2.5版

'发布：http://www.excelba.com

'*******************************************

Dim conn As ADODB.Connection

Dim WN As String

Dim TableName As String

Dim sSql As String

Dim tStr As String

'数据库名，请自行修改，路径与当前工作簿在同一目录

WN = "进销存表.mdb"

'数据库的表名与当前工作表名一致

TableName = ActiveSheet.Name

Set conn = New ADODB.Connection

conn.ConnectionString = "Provider=Microsoft.Jet.Oledb.4.0" &_

"Extended Properties=Excel 8.0" &_

"Data Source=" &ThisWorkbook.Path &"\" &ActiveWorkbook.Name

conn.Open

If conn.State = adStateOpen Then

sSql = "Insert Into [DataBase=" &ActiveWorkbook.Path &"\" &WN &"]." &TableName &" Select * From [" &ActiveSheet.Name &"$]"

conn.Execute sSql

MsgBox "成功把数据插入到“" &TableName &"”中！", , "http://excelba.com"

conn.Close

End If

Set conn = Nothing

End Sub

sub test()

Set cnn = CreateObject("ADODB.Connection")  

Set rs = CreateObject("Adodb.Recordset")strCn= "Provider=sqloledbServer=R9HDET7Database=dbnameUid=usernamePwd=password"

    cnn.Open strCn   

    SQL = ""

     cnn.Open strCn '与数据库建立连接，如果成功，返回连接对象cn

    rs.Open SQL , cn '执行strSQL所含的SQL命令，结果保存在rs记录集对象中    

    cnn.Close

    Set cnn = Nothing

end sub

请参考

连接数据库后，通过写SQL语句实现增删改查

Sub test()

     

    Dim cn As ADODB.Connection

    Dim strSQL As String

    Dim lngRecsAff As Long

    Dim Headers As Boolean

    Dim strConn As String

    Dim path As String

    

    On Error GoTo test_Error

    

    Headers = True

    path = "c:\20131212.xls"

    strConn = "Provider=Microsoft.Jet.OLEDB.4.0" & _

              "Data Source=" & path & "" & _

              "Extended Properties=""Excel 8.0 IMEX=1HDR=YES"""

                  

    Debug.Print strConn

    Set cn = New ADODB.Connection

    cn.Open strConn

     

     'Import by using Jet Provider.

    strSQL = "Insert INTO [odbcDriver={SQL Server}" & _

             "Server=192.168.6.111Database=answer" & _

             "UID=saPWD=password].test1 " & _

             "Select * FROM [Sheet1$]"

    Debug.Print strSQL

    cn.Execute strSQL, lngRecsAff

    Debug.Print "Records affected: " & lngRecsAff

     

    cn.Close

    Set cn = Nothing

     

    On Error GoTo 0

    Exit Sub

     

test_Error:

     

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure test of VBA Document ThisWorkbook"

     

End Sub

---