Function aCompareExistingFields(FilePathSource As String, FilePathIn As String) As Integer
'сравнение размеров и свойств всех полей таблиц из БД FilePathIn,
'обновление изменяемых
'имеющих одноименные поля таблиц в БД FilePathSource
'иногда вызывает ошибку открытия dbsSource, лечится импортом чего - нить куда -нить.
'выполняется крайне долго. Лучше не злоупотреБлять
Dim tbl As TableDef
Dim tblIn As TableDef
Dim i As Long, k As Long, j As Long
Dim aName As String

Dim dbsSource As Database, dbsIn As Database, FilePath As String
Dim fldS As Field, fldIn As Field, fName As String

Dim prpS As Property, prpIn As Property, pName As String
Debug.Print Time
On Error GoTo err_aTrOpenDBs
    Set dbsSource = DBEngine.Workspaces(0).OpenDatabase(FilePathSource)
    Set dbsIn = DBEngine.Workspaces(0).OpenDatabase(FilePathIn)

On Error Resume Next
    For k = 0 To dbsIn.TableDefs.Count - 1
        Set tblIn = dbsIn.TableDefs(k)
        aName = tblIn.Name
        Err.Clear
        Set tbl = dbsSource.TableDefs(aName)
        If Err.Number <> 0 Then
            Debug.Print "  В БД источнике нет табл " & aName
            Err.Clear
        Else
            For j = 0 To tblIn.Fields.Count - 1
                Set fldIn = tblIn.Fields(j)
                fName = fldIn.Name
                Err.Clear   'Только ошибку присвоения
                Set fldS = tbl.Fields(fName)
                If Err =  3265  Then  '<>0
                    'В источнике нет поля
                    Err.Clear
                Else
                    'поле есть
                    For i = 0 To fldS.Properties.Count - 1
                        Set prpS = fldS.Properties(i)
                        pName = prpS.Name
                        If pName <> "OrdinalPosition" Then
                            Set prpIn = fldIn.Properties(pName)
                            If prpS.Value <> prpIn.Value Then
                                If Err = 0 Then 'т.е. проперти имеет величину
                                    Debug.Print  "   ["  & aName &  "].["  & fName &  "].["  & pName &  "] ="  & prpS.Value &  " / "  & prpIn.Value
                                    If (pName <>  "Size" ) And (pName <>  "Type" ) Then 'And (pName <> "Attributes")  не все атрибуты, но можно менять
                                        prpIn.Value = prpS.Value
                                        'tblIn.Fields.Refresh ' попытка избавиться от висюка
                                        If Err <> 0 Then
                                            Debug.Print Err.Description
                                            Err.Clear
                                        End If
                                    End If
                                Else
                                    Err.Clear
                                End If
                            End If
                            If Err <> 0 Then
                                Debug.Print Err.Description
                                Err.Clear
                            End If
                        End If
                        Set prpIn = Nothing
                        Set prpS = Nothing
                    Next i
                End If
                Set fldS = Nothing
                Set fldIn = Nothing
            Next j
        End If
        'dbsIn.TableDefs.Refresh ' попытка избавиться от висюка
    Next k
    Debug.Print Time
    'dbsSource.Close - тут висяк
    'dbsIn.Close
err_aCompareExistingFields:
    Set tbl = Nothing
    Set tblIn = Nothing
    Set dbsSource = Nothing
    Set dbsIn = Nothing
    aCompareExistingFields = True
    Debug.Print Time
    Exit Function
    
err_aTrOpenDBs:
    MsgBox Err.Description
    Resume err_aCompareExistingFields
End Function

?aCompareExistingFields( "C:\xxx.mdb"  ,  "C:\yyy.mdb" )
 14 : 34 : 56  
  В БД источнике нет табл ttttt
 14 : 35 : 00  
 14 : 36 : 26  
- 1  

?aCompareExistingFields( "C:\xxx.mdb"  ,  "C:\yyy.mdb" )
 15 : 06 : 47  
  В БД источнике нет табл ttttt
 15 : 06 : 51  
 15 : 08 : 17  
- 1  

                        If pName <>  "OrdinalPosition"  Then
                            'Set prpIn = fldIn.Properties(pName)
                            Dim o As Long
                                For o =  0  To fldIn.Properties.Count -  1 
                                    If fldIn.Properties(i).Name = pName Then
                                        Set prpIn = fldIn.Properties(o)
                                        Exit For
                                    End If
                                Next o
                            If prpS.Value <> prpIn.Value Then

?aCompareExistingFields( "C:\xxx.mdb"  ,  "C:\yyy.mdb" )
 11 : 38 : 38  
  В БД источнике нет табл ttttt
 11 : 38 : 42  
 11 : 39 : 58  
- 1  

?mCompareExistingFields( "C:\xxx.mdb"  ,  "C:\yyy.mdb" )
 14 : 38 : 09  A
  В БД источнике нет табл ttttt
 14 : 38 : 25  B
 14 : 38 : 26  dbsSource.Close
   [COUNTRY].[Name].[Size] = 51  /  50 
   [COUNTRY].[Name].[DefaultValue] = "Страна"  / 
   [Payments].[Summa_Count].[DefaultValue] = 1  /  0 
 14 : 38 : 28  dbsIn.Close
 14 : 38 : 28  end
- 1  

?mCompareExistingFields( "C:\xxx.mdb"  ,  "C:\yyy.mdb" )
 14 : 40 : 56  A
  В БД источнике нет табл ttttt
 14 : 41 : 12  B
 14 : 41 : 13  dbsSource.Close
   [COUNTRY].[Name].[Size] = 51  /  50 
   [COUNTRY].[Name].[DefaultValue] = /  "Страна" 
   [Payments].[Summa_Count].[DefaultValue] = 0  /  1 
 14 : 41 : 15  dbsIn.Close
 14 : 41 : 15  end
- 1