自动识别添加或更新数据到数据库

功能：判断EXCEL指定单元格区域内的数据在数据库中是否存在如果存在将更新指定区域单元格内的数据到数据库中，如果有区域内有新增的数据那么将新增的数据添加到数据库。

如果指定区域内的数据在数据库中不存在将添加指定区域内单元格的数据到数据库中。

代码

Sub saveTeamMem()

Dim rs As New ADODB.Recordset
Dim cnn As String
Dim sql As String
pn = ThisWorkbook.Sheets("A3").Range("AF4").Value
cnn = "Provider=Microsoft.ACE.OLEDB.16.0;" & _
    "Data Source=" & ThisWorkbook.Path & ".\A3db2019.accdb"

sql = "select ProjectID,MemName,MemDept,MemRole from A3_TeamMem where projectID='" & pn & "'"
Set rs = New Recordset
rs.Open sql, cnn, 1, 3
With ThisWorkbook.Sheets("A3")
    For i = 27 To 35
        If .Range("C" & i) <> "" Then
            n = i     'The Max row number in which data exists on excel worksheet
            t = t + 1 'Calculate the number of rows in which data exists on excel worksheet
        End If
    Next i
    
    If rs.RecordCount = 0 Then
        For j = 27 To n
            rs.AddNew
            rs.Fields("ProjectID") = .Range("AF4").Value
            rs.Fields("MemName") = .Range("C" & j).Value
            rs.Fields("MemDept") = .Range("F" & j).Value
            rs.Fields("MemRole") = .Range("I" & j).Value
            rs.Update
        Next j
        MsgBox "Update sucessful!"
        Exit Sub
    Else
        Total = rs.RecordCount
        p = 0
        If Total < t Then
           Do
                p = p + 1
                rs.MoveLast
                rs.AddNew
                rs.Fields("ProjectID") = .Range("AF4").Value
                rs.Fields("MemName") = "-"
                rs.Fields("MemDept") = "-"
                rs.Fields("MemRole") = "-"
                rs.Update
                Currtotal = rs.RecordCount
                currNum = t - Total
            Loop Until p = currNum
        Call updateTeamMem(n)
        End If
        d = 0
        If t < Total Then
            Do
                d = d + 1
                rs.MoveLast
                rs.Delete
            Loop Until d = Total - t
        End If
    End If
End With
Call updateTeamMem(n)
rs.Close
End Sub


Sub updateTeamMem(num)

Dim rs As New ADODB.Recordset
Dim cnn As String
Dim sql As String
pn = ThisWorkbook.Sheets("A3").Range("AF4").Value
cnn = "Provider=Microsoft.ACE.OLEDB.16.0;" & _
    "Data Source=" & ThisWorkbook.Path & ".\A3db2019.accdb"
On Error Resume Next
sql = "select ProjectID,MemName,MemDept,MemRole from A3_TeamMem where projectID='" & pn & "'"
Set rs = New Recordset
rs.Open sql, cnn, 2, 3
With ThisWorkbook.Sheets("A3")
    For k = 27 To num
        rs.Fields("MemName") = .Range("C" & k).Value
        rs.Fields("MemDept") = .Range("F" & k).Value
        rs.Fields("MemRole") = .Range("I" & k).Value
        rs.MoveNext
        rs.Update
    Next
    MsgBox "Update sucessful!"
End With
End Sub