Sub Database_Update() 

    Dim db As Database 
    Dim ws As Workspace 
    Dim rst As Recordset 
    Dim sConnection As String 
    Dim sAdr As String 
    Dim i As Integer 
    Dim iReplaceCount As Integer 

    Set ws = DBEngine.CreateWorkspace("myName", "UID", "", dbUseODBC) 
    
    sConnection = "ODBC;DSN=ORA;UID=lomaster;PWD=123;SERVER=oracle;" 
    Set db = ws.OpenDatabase("", False, False, sConnection) 
    Set rst = db.OpenRecordset("select code, adr from person where em = '28'") 

    i =  1  
    iReplaceCount =  0  
    With rst 
        Do 
            sAdr = .Fields("adr").Value 
            If IsNumeric(Left$(sAdr,  6 )) Then 
                .Edit 
                .Fields("ps_adr_1").Value = Right$(sAdr, Len(sAdr) -  7 ) 
                iReplaceCount = iReplaceCount +  1  
            End If 
            .MoveNext 
            i = i +  1  
        Loop While Not .EOF 
    End With 
    
    rst.Update 
    rst.Close 
    db.Close 
    ws.Close 
    
    MsgBox "Обработано записей: " & i -  1  & vbNewLine & "Изменено полей: " & iReplaceCount 
End Sub 

strSQL = "UPDATE person SET ps_adr_1 = '" & sAdr & "' WHERE ps_code = '" & sCode & "' AND em = '28'" 
db.Execute strSQL 

Option Explicit

Sub Database_Update()

    Dim db As Database
    Dim ws As Workspace
    Dim rst As Recordset
    Dim sConnection As String
    Dim sChangeData As String
    Dim sCode As String
    Dim iNumRec As Long
    Dim iReplaceCount As Integer
    Dim strSQL As String
    Dim sFieldName As String
    Dim sIndexKeyFieldName As String
    Dim sIndexKey As String
        
    Set ws = DBEngine.CreateWorkspace("myName", "UID", "", dbUseODBC)

    sConnection = "ODBC;DSN=ORA;UID=myname;PWD=mypassword;SERVER=oracle;"
    Set db = ws.OpenDatabase("", False, False, sConnection)

	strSQL = "SELECT * FROM person WHERE company = '568'"
    Set rst = db.OpenRecordset(strSQL, dbOpenDynaset, dbExecDirect, dbOptimisticValue)

    sFieldName = "ps_name"
    sIndexKeyFieldName = "number"
    iNumRec =  1 
    iReplaceCount =  0 
    With rst
        Do
			sChangeData = .Fields(sFieldName).Value
			If sChangeData = "Старые данные" Then
				sChangeData = "Новые данные"
'-------------------------------------------------
' 1-й вариант
				.Edit
				.Fields(sFieldName).Value = sChangeData
				.Update
'-------------------------------------------------
' или 2-й вариант (возможно даже быстрее чем 1-й)
				sIndexKey = .Fields(sIndexKeyFieldName).Value
				strSQL = "UPDATE person SET " & sFieldName & " = '" & sChangeData & "' WHERE " & sIndexKeyFieldName & " = " & sIndexKey
				db.Execute strSQL
'-------------------------------------------------
				iReplaceCount = iReplaceCount +  1 
			End If
            iNumRec = iNumRec +  1 
            .MoveNext
        Loop While Not .EOF
    End With
    
    rst.Close
    db.Close
    ws.Close
    
    MsgBox "Обработано записей: " & iNumRec -  1  & vbNewLine & "Изменено полей: " & iReplaceCount
End Sub