|
这段代码,想把一张EXCEL表的数据一次性导入ACCESS数据库
运行错误好象是日期的格式不匹配,不知道究竟该是2011-7-7和2011-07-07
请高手指教,多谢!
Private Sub 数据备份()
Dim myData As String, myTable As String
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Long, j As Long
Dim myCmd As ADODB.Command
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Set wb = ThisWorkbook
Set ws = wb.Sheets("预算使用数据") '指定数据来源
myData = ThisWorkbook.Path & "\预算数据备份.mdb" '数据库名称
myTable = "预算执行信息" '数据库表名
Set cnn = New ADODB.Connection
With cnn
.Provider = "microsoft.jet.oledb.4.0"
.Open myData
End With
N = ws.Range("E65536").End(xlUp).Row '本文档中库存数据表的最大行
For i = 2 To N
SQL = "select * from " & myTable _
& " where 登记日期='" & Format(ws.Cells(i, 1).Value, "yyyy-mm-dd") & "'" _
& " and 单据号='" & ws.Cells(i, 2).Value & "'" _
& " and 预算期间='" & ws.Cells(i, 3).Value & "'" _
& " and 预算单位='" & ws.Cells(i, 4).Value & "'" _
& " and 预算编码='" & ws.Cells(i, 5).Value & "'" _
& " and 工作任务='" & ws.Cells(i, 6).Value & "'" _
& " and 具体步骤及内容='" & ws.Cells(i, 7).Value & "'" _
& " and 预算分类='" & ws.Cells(i, 8).Value & "'" _
& " and 预算科目='" & ws.Cells(i, 9).Value & "'" _
& " and 金额='" & ws.Cells(i, 10).Value & "'" _
& " and 项目编号='" & ws.Cells(i, 11).Value & "'" _
& " and 供应商合同编号='" & ws.Cells(i, 12).Value & "'" _
& " and 使用人='" & ws.Cells(i, 13).Value & "'" _
& " and 备注='" & ws.Cells(i, 14).Value & "'"
Set rs = New ADODB.Recordset
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount = 0 Then
rs.AddNew
For j = 2 To rs.Fields.count
rs.Fields(j - 1) = ws.Cells(i, j).Value
Next j
rs.Update
Else
For j = 2 To rs.Fields.count
rs.Fields(j - 1) = ws.Cells(i, j).Value
Next j
rs.Update
End If
Next i
MsgBox "数据保存完毕!", vbInformation + vbOKOnly
ws.Range("A2:O" & N).ClearContents
rs.Close
cnn.Close
'Set wb = Nothing
'Set ws = Nothing
Set rs = Nothing
Set myCmd = Nothing
Set cnn = Nothing
End Sub |
|