我无法获取我的代码来添加新记录并更新我所拥有的表中的现有记录。我有两张桌子;一个临时表(tblTempData)和另一个表(tblCommon)。我希望代码检查是否存在记录,然后更新列和&如果记录是新的,则添加新记录。当我运行代码时,tblCommon为空。我不知道哪个部分是错的。将感谢您的指导和建议。
以下是我的代码:
Dim rsTemp As DAO.Recordset
Dim rsCommon As DAO.Recordset
Dim id1 As String
Dim id2 As String
Set rsTemp = CurrentDb.OpenRecordset("SELECT * FROM tblTempData", dbOpenDynaset)
Set rsCommon = CurrentDb.OpenRecordset("SELECT * FROM tblCommon", dbOpenDynaset)
rsTemp.MoveFirst
id1 = rsTemp![Item ID]
rsTemp.MoveNext
Do Until rsTemp.EOF
id2 = rsTemp![Item ID]
If id1 = id2 Then
With rsCommon
If .RecordCount = 0 Then
.AddNew
![Item Description] = rsTemp![Item Description]
![Material Number] = rsTemp![Material Number]
![User] = rsTemp![User]
![Supplier] = rsTemp![Supplier]
![Current Status] = rsTemp![Current Status]
![Remarks] = rsTemp![Remarks]
![Item ID] = id2
.Update
.Close
Else
.FindFirst "[Item ID] = '" & id2 & "'"
If .NoMatch Then
.AddNew
![Item Description] = rsTemp![Item Description]
![Material Number] = rsTemp![Material Number]
![User] = rsTemp![User]
![Supplier] = rsTemp![Supplier]
![Current Status] = rsTemp![Current Status]
![Remarks] = rsTemp![Remarks]
![Item ID] = id1
.Update
.Close
Else
.Edit
![Item Description] = rsTemp![Item Description]
![Material Number] = rsTemp![Material Number]
![User] = rsTemp![User]
![Supplier] = rsTemp![Supplier]
![Current Status] = rsTemp![Current Status]
![Remarks] = rsTemp![Remarks]
![Item ID] = id2
.Update
.Close
End If
End If
End With
Else
Exit Sub
End If
id1 = id2
rsTemp.MoveNext
Loop
Set rsTemp = Nothing
Else
Exit Sub
End If
由于
答案 0 :(得分:1)
另一种方法。
尝试通过为每项任务Exists()
,Add()
和Update()
创建帮助函数来细分代码。阅读和维护代码会更容易。
Option Explicit
Private rsCommon As DAO.Recordset
Public Sub UpdateExistingRecords()
On Error GoTo ErrTrap
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT * FROM tblTempData", dbOpenSnapshot)
Set rsCommon = CurrentDb().OpenRecordset("SELECT * FROM tblCommon", dbOpenDynaset)
Dim idx As Long
For idx = 1 To rs.RecordCount
If ExistsInCommon(rs![Item ID]) Then
If Not Update(rs) Then
MsgBox "Failed to update.", vbExclamation
GoTo Leave
End If
Else
If Not Add(rs) Then
MsgBox "Failed to add.", vbExclamation
GoTo Leave
End If
End If
rs.MoveNext
Next
Leave:
If Not rs Is Nothing Then rs.Close
If Not rsCommon Is Nothing Then rsCommon.Close
Set rs = Nothing
Set rsCommon = Nothing
Exit Sub
ErrTrap:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
' Exists - 'Assumes Id is String
Private Function ExistsInCommon(ByVal Id As String)
ExistsInCommon = DCount("*", "tblCommon", "[Item ID] = '" & Id & "'") > 0
End Function
' Update
Private Function Update(rs As DAO.Recordset) As Boolean
With rsCommon
.FindFirst "[Item ID] = '" & rs![Item ID] & "'"
If .NoMatch Then Exit Function
.Edit
![Item Description] = rs![Item Description]
![Material Number] = rs![Material Number]
![User] = rs![User]
![Supplier] = rs![Supplier]
![Current Status] = rs![Current Status]
![Remarks] = rs![Remarks]
.Update
.MoveFirst
End With
Update = True
End Function
'Add
Private Function Add(rs As DAO.Recordset) As Boolean
With rsCommon
.AddNew
![Item Description] = rs![Item Description]
![Material Number] = rs![Material Number]
![User] = rs![User]
![Supplier] = rs![Supplier]
![Current Status] = rs![Current Status]
![Remarks] = rs![Remarks]
![Item ID] = rs![Item ID]
.Update
End With
Add = True
End Function