VBA将Excel中的数据导入数据库

将Excel中的数据导入到Access中，前提是在Access中的表已经建好。

dim conn

dim conn2

set conn=CreateObject("ADODB.Connection")

conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database PassWord=;Data Source=c:\book1.mdb"

set conn2=CreateObject("ADODB.Connection")

conn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=;Extended properties=Excel 5.0;Data Source=c:\book1.xls"

sql = "SELECT * FROM [Sheet1$]"

set rs = conn2.execute(sql)

while not rs.eof

sql = "insert into xxx([a],[b],[c],[d]) values('"& fixsql(rs(0)) &"','"& fixsql(rs(1)) &"','"& fixsql(rs(2)) &"','"& fixsql(rs(3)) &"')" conn.execute(sql)

rs.movenext

wend

conn.close

set conn = nothing

conn2.close

set conn2 = nothing

function fixsql(str)

dim newstr

newstr = str

if isnull(newstr) then

newstr = ""

else

newstr = replace(newstr,"'","''")

end if

fixsql = newstr

end function

导入到Sql Server数据库中时，如果Excel文件和数据库不在同一台服务器上时，请参考上面的代码。在同一机器上可以参考下面代码（不需要先把表建表，程序会自己动建表，用Excel中的第一行数据做为表的字段名）：

dim conn

set conn=CreateObject("ADODB.Connection")

conn.Open ("driver={SQL

Server};server=localhost;uid=sa;pwd=sa;database=hwtemp;")

sql = "SELECT * into newtable FROM

OpenDataSource( 'Microsoft.Jet.OLEDB.4.0','Data

Source=""c:\book1.xls"";User ID=Admin;Password=;Extended

properties=Excel 5.0')...[Sheet1$] "

conn.execute(sql)

conn.close

set conn = nothing

另一个例子：

Sub Macro1()

'

' Macro1 Macro

' 宏由 hgd 录制，时间: 2006-7-21

'

' 快捷键: Ctrl+z

'

'Sub shangpingzu()------连接SQL数据库

Set x = CreateObject("adodb.connection")

Set y = CreateObject("adodb.recordset")

Application.DisplayAlerts = False

Application.CutCopyMode = False

x.Open "DSN=a;Uid=sa;Pwd=;"

'Dim xx As String

'Dim yy As String

'Dim i As Integer

'For i = 2 To Sheets(1).Rows(65536).End(xlUp).Row

'xx = Sheets(1).Cells(i, 1)

'yy = Sheets(1).Cells(i, 2)

'xx = Sheets(1).Rows(65536).End(xlUp).Row

'yy = Sheets(1).Cells(1, 255).End(xlToLeft).Column

'Sheets(1).Cells(2, 3) = xx

'Sheets(1).Cells(2, 4) = yy

Sql = "insert into book values('" & Sheets(1).Cells(i, 1) & "'" For j = 2 To Sheets(1).Cells(1, 255).End(xlToLeft).Column

Sql = Sql & " , '" & Sheets(1).Cells(i, j) & "'"

Next j

Sql = Sql & ")"

'& xx & "," & yy & ")"

Set y = x.Execute(Sql)

'Next i

End Sub