Скрипт следующий:

'\\==========================================================================

'\\сравнение столбцов таблиц сервера и access

Sub Compare_Hat_Columns()

'Dim oSh As Worksheet

'Dim LngRowStart As Long, LngRowEnd As Long

Dim arValMain As Variant, arVal1 As Variant, arVal2 As Variant

Dim i As Long, j As Long

Dim strTemp As String

arValMain = Fn_Array_Column_in_tbl_Server("ListIncident")

arVal2 = Fn_Array_Column_in_tbl_Access("ListIncident")

' ReDim arValMain(0 To 1, LBound(arVal1, 2) To UBound(arVal1, 2))

'ищем значения первого массива во втором

For i = LBound(arValMain, 2) To UBound(arValMain, 2)

strTemp = arValMain(0, i)

arValMain(1, i) = "-" 'заранее ставим ноль для отсутсвующих значений

' arValMain(2, i) = arVal1(1, i) 'дефолтное значение поля

For j = LBound(arVal2, 2) To UBound(arVal2, 2)

If strTemp = arVal2(0, j) Then

arValMain(1, i) = j 'позиция(№) в массиве таблицы access

Exit For

End If

Next j

Debug.Print i, arValMain(1, i), arValMain(0, i), arValMain(2, i)

Next i

End Sub

'\\==========================================================================

'\\ массив названий столбцов таблицы на сервере

Function Fn_Array_Column_in_tbl_Server(ByVal strTblName As String) As Variant

'\\Подключение к серверу, если не подключен

If cn Is Nothing Then If Not Fn_Server_Connect() Then Stop

Dim rs As New ADODB.Recordset

strSql = "SELECT COLUMN_NAME ,ORDINAL_POSITION , COLUMN_DEFAULT " & vbCrLf & _

"FROM INFORMATION_SCHEMA.COLUMNS " & vbCrLf & _

"WHERE TABLE_NAME = '" & strTblName & "' " & vbCrLf & _

"ORDER BY ORDINAL_POSITION ASC;"

rs.Open strSql, cn

Fn_Array_Column_in_tbl_Server = rs.GetRows()

' bln_DisConnect = Fn_Server_DisConnect(cn)

bln_DisConnect = Fn_RS_DisConnect(rs)

End Function

'\\==========================================================================

'\\ массив названий столбцов таблицы access

'arr = Fn_Array_Column_in_tbl_Access("ListIncident")

Function Fn_Array_Column_in_tbl_Access(ByVal strTblName As String) As Variant

Dim iCh As Integer: iCh = 0

Dim arr As Variant

Dim strSql As String

Dim rs As ADODB.Recordset

Dim oFld As ADODB.Field

'загружаем одну строку(все остальные способы работают очень медленно)

strSql = "SELECT top 1 [" & strTblName & "].* FROM [" & strTblName & "];"

Set rs = Fn_RS_OPEN(strSql)

ReDim arr(0 To 1, 0 To iCh)

For Each oFld In rs.Fields

' Debug.Print oFld.Name; oFld.Type

ReDim Preserve arr(0 To 1, 0 To iCh)

arr(0, iCh) = oFld.Name '!COLUMN_NAME

arr(1, iCh) = iCh 'oFld.Type '!ORDINAL_POSITION

iCh = iCh + 1

Next

Fn_Array_Column_in_tbl_Access = arr

End Function