Private Sub Refr()
On Error Resume Next
Adodc1.Refresh
Adodc1.RecordSource = "SELECT * FROM Baz where [Mes]= " & MPlan & " and [God]= " & GodPlan & " AND [Pl] = 1"
'Adodc1.CommandType = adCmdText
Adodc1.Refresh
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
'Становимся на нужную запись и жмем кнопку
Adodc1.Recordset("Pl") =  0 
Adodc1.Recordset.Update
Adodc1.Refresh
Call Refr '
End Sub

Private Sub XpB2_Click()
On Error GoTo ado3
Adodc1.Refresh
TDataLite1.Refresh
Label3.Visible = False
XpB9.Visible = True
Adodc2.ConnectionString = "DRIVER={Microsoft dBase Driver (*.dbf)};DBQ=C:\obmen\archive\;DefaultDir = C:\obmen\archive\"
Adodc2.CommandType = adCmdText
Adodc2.RecordSource = "SELECT * FROM " + CommonDialog1.FileTitle
Set TDataLite2.DataSource = Adodc2
Adodc2.Refresh
TDataLite2.Refresh
Do Until List1.ListCount =  0 
    List1.RemoveItem  0 
Loop
ad1 = Me.Adodc1.Recordset.RecordCount
ad2 = Me.Adodc2.Recordset.RecordCount
nom =  0 
For i =  0  To ad1

Me.Adodc2.Recordset.MoveFirst
If Me.Adodc1.Recordset.EOF = False Then

namefilt1 = Me.Adodc1.Recordset("KOD").Value
namefilt1name = Me.Adodc1.Recordset("NAME").Value
namefilt2 = Me.Adodc2.Recordset("KOD").Value
Me.Adodc2.Recordset.Find "KOD =" + namefilt1
If Adodc2.Recordset.EOF Then
    
 Else
 List1.AddItem (namefilt1name)
 Me.Adodc1.Recordset("ZAKAZ").Value =  0 
  nom = nom +  1 
 End If
 
 End If
Me.Adodc1.Recordset.MoveNext
Next i
Label1.Caption = "Обработка выполнена ,обработано " + Str(nom)
Adodc1.Refresh
TDataLite1.Refresh
Adodc2.Refresh
TDataLite2.Refresh
Exit Sub
ado3:
Label1.Caption = "Ошибка обработано только " + Str(nom)
MsgBox "Обработано с ошибками , причина в несовпадении некоторых строк,НЕ СТРАШНО" + vbCr + vbCr + Err.Description
End Sub