VBA 从excel取数据到mdb里面,如果有重复则更新数据

Sub F_Sample026()
    Dim myCon      As New ADODB.Connection
    Dim myRst      As New ADODB.Recordset
    Dim myFileName As String
    Dim myTblName  As String
    Dim myKey      As String
    Dim mySht      As Worksheet
    Dim i          As Long
    Dim j          As Long
    Dim nn&
    myFileName = "F_Data.mdb"
    myTblName = "F_Tbl01"
    myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & ThisWorkbook.Path & "\" & myFileName & ";"
    
    myCon.Execute "DELETE FROM " & myTblName & " WHERE 编号> 50"
    
    Set mySht = Worksheets("F_Data01")
    
    With myRst
        .Index = "PrimaryKey"                                     '设置查找是以主键开始查找
        myRst.Open Source:=myTblName, ActiveConnection:=myCon, _
        CursorType:=adOpenKeyset, LockType:=adLockOptimistic, _
        Options:=adCmdTableDirect
        
        For i = 2 To mySht.Range("A65536").End(xlUp).Row
            myKey = mySht.Cells(i, 1).Value
            
            If Not .EOF Then .Seek myKey       '如果不是空表那么 就把游标移到等于myKey的record上去            
            If .EOF Then                        ’如果移到的位置是超过了最大范围就在最后新增一条数据
                'MsgBox "新增为新数据"
                .AddNew
                For j = 1 To .Fields.Count
                    .Fields(mySht.Cells(1, j).Value).Value = mySht.Cells(i, j).Value
                Next j
                .Update
            Else                                  ’如果移到的位置是一个既存的record的话就修订这个record
               ' MsgBox "修订既存数据"
                For j = 2 To .Fields.Count
                    myRst(j - 1).Value = mySht.Cells(i, j).Value
                Next
                .Update
            End If
        Next i
        .Close
    End With
    myCon.Close
    Set myRst = Nothing
    Set myCon = Nothing
End Sub

 

posted on 2013-12-08 21:55  鱼东鱼  阅读(839)  评论(0编辑  收藏  举报

导航