將Excel資料匯出到Access 資料庫

Sub test()
Dim cn As Object
Dim rs As Object
Dim rs2 As Object
Dim i As Long
Dim iCount As Long
Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set rs2 = CreateObject("adodb.recordset")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\temp\db1.mdb;Persist Security Info=False"
rs.cursorlocation = 3
rs.Open "Select * From NewData", cn, 1, 3
For i = 1 To 65535
iCount = 0
If Range("A" & i).Text <> "" Then
If rs2.State = 1 Then rs2.Close
rs2.cursorlocation = 3
rs2.Open "Select * From NewData where [編號]=" & Range("A" & i).Text, cn, 0, 1 '數字要這樣
'rs2.Open "Select * From NewData where 編號='" & Range("A" & i).Text & "'", cn, 0, 1 '文字改這樣
iCount = rs2.RecordCount
End If
If iCount = 0 Then
rs.addnew
rs("編號") = IIf(Range("A" & i).Text = "", Null, Range("A" & i).Text)
End If
rs("名稱") = IIf(Range("B" & i).Text = "", Null, Range("B" & i).Text)
rs("數量") = IIf(Range("C" & i).Text = "", Null, Range("C" & i).Text)
If rs("編號") & "" = "" And rs("名稱") & "" = "" And rs("數量") & "" = "" Then
rs.cancelupdate
Exit For
End If
rs.Update
Next
End Sub