excel导入ACCESS时 防止数据重复导入问题
代码是要将EXCEL数据导入到ACCESS中，代码验证成功，但就是将数据重复导入到ACCESS中了。如何防止数据重复导入，应该怎么写代码啊。求高手指点。红色的代码是我写的防止重复导入的，但是不成功。Private Sub Command3_Click()
Dim excel_app As Object
Dim excel_sheet As Object
If txtExcelFile.Text = "Excel路径" Then
MsgBox "请选择EXCEL表"
Exit Sub
End If
If txtAccessFile.Text = "Access路径" Then
MsgBox "请选择Access表"
Exit Sub
End If
Label1.Caption = "正在导入,请稍候..."
Screen.MousePointer = vbHourglass
DoEvents
' Create the Excel application.
Set excel_app = CreateObject("Excel.Application")
' Uncomment this line to make Excel visible.
excel_app.Visible = True
' Open the Excel spreadsheet.
excel_app.Workbooks.Open FileName:=txtExcelFile.Text
' Check for later versions.
If Val(excel_app.Application.Version) >= 8 Then
Set excel_sheet = excel_app.ActiveSheet
Else
Set excel_sheet = excel_app
End If
Dim u '求EXCEL表中记录的条数,以便控制进度条
u = 1
Do
If Trim$(excel_sheet.Cells(u, 1)) = "" Then Exit Do
u = u + 1
Loop
bar.Max = u - 1
Dim sql As String
sql = "select * from dgjj"
rs.Open sql, conn.ConnectionString, adOpenStatic, adLockOptimistic '打开记录集
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim v '导入记录,用了两层循环
v = 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Do
If Trim$(excel_sheet.Cells(v, 1)) = "" Then Exit Do '外层,如果EXCEL表中读取到空行,结束
If rs.EOF And rs("gsmc") = Trim$(excel_sheet.Cells(v, 1)) And rs("jyzmc") = Trim$(excel_sheet.Cells(v, 2)) And rs("gh") = Trim$(excel_sheet.Cells(v, 3)) And rs("rq") = Trim$(excel_sheet.Cells(v, 4)) And rs("ch") = Trim$(excel_sheet.Cells(v, 5)) And rs("ckv20") = Trim$(excel_sheet.Cells(v, 7)) And rs("syl") = Trim$(excel_sheet.Cells(v, 21)) Then
MsgBox "已经包含该条数据！"
Else
rs.AddNew
rs("gsmc") = Trim$(excel_sheet.Cells(v, 1))
rs("jyzmc") = Trim$(excel_sheet.Cells(v, 2))
rs("gh") = Trim$(excel_sheet.Cells(v, 3))
rs("rq") = Trim$(excel_sheet.Cells(v, 4))
rs("ch") = Trim$(excel_sheet.Cells(v, 5))
rs("ph") = Trim$(excel_sheet.Cells(v, 6))
rs("ckv20") = Trim$(excel_sheet.Cells(v, 7))
rs("psdv20") = Trim$(excel_sheet.Cells(v, 8))
rs("dzv20") = Trim$(excel_sheet.Cells(v, 9))
rs("xqyg") = Trim$(excel_sheet.Cells(v, 10))
rs("xqv20") = Trim$(excel_sheet.Cells(v, 11))
rs("xqvt") = Trim$(excel_sheet.Cells(v, 12))
rs("xhyg") = Trim$(excel_sheet.Cells(v, 13))
rs("xhv20") = Trim$(excel_sheet.Cells(v, 14))
rs("xhvt") = Trim$(excel_sheet.Cells(v, 15))
rs("xrv20") = Trim$(excel_sheet.Cells(v, 16))
rs("lgv20") = Trim$(excel_sheet.Cells(v, 17))
rs("sy") = Trim$(excel_sheet.Cells(v, 18))
Dim a As Double
a = Trim$(excel_sheet.Cells(v, 19))
a = Round(a, 2)
rs("syl") = a
bar.Value = v
v = v + 1
rs.MoveNext
Loop
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comment the rest of the lines to keep
' Excel running so you can see it.
' Close the workbook without saving.
excel_app.ActiveWorkbook.Close False
' Close Excel.
excel_app.Quit
Set excel_sheet = Nothing
Set excel_app = Nothing
Refresh
rs.Close
Set rs = Nothing
Label1.Caption = "导入完毕"
Screen.MousePointer = vbDefault
MsgBox "共导入" & Format$(v - 1) & "条记录"
End Sub
[ 本帖最后由 lzxagy 于 2012-10-18 17:18 编辑 ]
