'\\==========================================================================
'\\сравнение столбцов таблиц сервера и 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