Обновление полей таблицы данными другой только если значения в таблице назначения пустыПо материалам: https://www.access-programmers.co.uk/forums/threads/copy-data-from-one-table-to-another.325289/ Private Sub UpdateRecordsIfIsEmpty() ' Copying the data from table "Investments01_Appendix" to the table "Investments01_tbl", _ ONLY if the same field name in table "Investments01_tbl" is empty. '-------------------------------------------------------------------------------------------------- 'https://www.access-programmers.co.uk/forums/threads/copy-data-from-one-table-to-another.325289/ '-------------------------------------------------------------------------------------------------- Dim rsSRS As DAO.Recordset Dim rsDST As DAO.Recordset Dim objField As DAO.Field Dim sVal$, lRecID&, lCountRecords&, lCountUpdates&, dTimer As Date On Error GoTo UpdateRecordsIfIsEmpty_Err dTimer = Now sVal = "Select * From Investments01_Appendix" Set rsSRS = CurrentDb.OpenRecordset(sVal, dbOpenSnapshot) With rsSRS Do Until .EOF = True lRecID = !InvestmentID sVal = "Select * From Investments01_tbl WHERE Investmentl_ID = " & lRecID Set rsDST = CurrentDb.OpenRecordset(sVal, dbOpenDynaset) If rsDST.RecordCount > 0 Then For Each objField In .Fields If IsNull(objField.Value) = False Then If IsFieldPresent(rsDST, objField.Name) = True Then 'if the same field name in table is empty: If IsNull(rsDST(objField.Name).Value) Then rsDST.Edit rsDST(objField.Name).Value = objField.Value rsDST.Update lCountUpdates = lCountUpdates + 1 End If End If End If Next End If rsDST.Close lCountRecords = lCountRecords + 1 .MoveNext Loop End With sVal = "Processed records: " & lCountRecords & " - Updated: " & lCountUpdates & _ " Values. Duration: " & Format(Now - dTimer, "hh:nn:ss") Debug.Print sVal UpdateRecordsIfIsEmpty_End: On Error Resume Next Set objField = Nothing rsSRS.Close Set rsSRS = Nothing rsDST.Close Set rsDST = Nothing Err.Clear Exit Sub UpdateRecordsIfIsEmpty_Err: MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _ "in Sub: UpdateRecordsIfIsEmpty in module: [Your Module Name]", vbCritical, "Error in Application" Resume UpdateRecordsIfIsEmpty_End End Sub Private Function IsFieldPresent(rs As DAO.Recordset, sFieldName As String) As Boolean Dim objField As Field '-------------------------------------------------------------------------------------------------- On Error GoTo IsFieldPresent_Err Set objField = rs.Fields(sFieldName) IsFieldPresent = True IsFieldPresent_Bye: Set objField = Nothing Exit Function IsFieldPresent_Err: Err.Clear Resume IsFieldPresent_Bye End Function |
|||
L.E. 24.10.2022 |