VBA, MS Access MS Access в примерах

Обновление полей таблицы данными другой только если значения в таблице назначения пусты

По материалам: 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


Назад ToTop
L.E. 24.10.2022
Рейтинг@Mail.ru