'функция создает и заполняет ImageList из таблицы и из файлов
Public Function LoadIconList() As Boolean
Dim rst As ADODB.Recordset
Dim fnum As Long
Dim bytPic() As Byte
Dim i As Long
Dim obj As Object
Dim strTemp As String
Dim strTemp1 As String

    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = CurrentProject.Connection
        .LockType = adLockReadOnly
        .CursorLocation = adUseClient
        .CursorType = adOpenKeyset
        .Source =  "SELECT * FROM Icons" 
        .Open
    End With
    Set rst.ActiveConnection = Nothing
    
    Set MyImageList = Nothing
    If MyImageList Is Nothing = True Then Set MyImageList = CreateObject( "MSComctlLib.ImageListCtrl" )
    With MyImageList
        If .ListImages.Count =  0  Then
            .ImageHeight =  16 
            .ImageWidth =  16 
            .UseMaskColor = True
        End If
    End With
    For i =  0  To rst.RecordCount -  1 
        bytPic() = rst.Fields( "Image" ).GetChunk(rst.Fields( "Image" ).ActualSize)
        fnum = FreeFile
        Open CurrentProject.Path &  "\tempicon.dat"  For Binary As #fnum
        Put #fnum,  1 , bytPic()
        Close #fnum
        Set obj = MyImageList.ListImages.Add(, rst!Name.Value, LoadPicture(CurrentProject.Path &  "\tempicon.dat" ))
        obj.Tag = rst!TYP
        rst.MoveNext
        Kill CurrentProject.Path &  "\tempicon.dat" 
    Next i
    rst.Close
    Set rst = Nothing
    
    strTemp = Dir(CurrentProject.Path &  "\*.ico" )
    While Len(strTemp) >  0 
        strTemp1 = Right(strTemp, Len(strTemp) - InStrRev(strTemp,  "\" ))
        strTemp1 = Left(strTemp1, Len(strTemp1) -  4 )
        Set obj = MyImageList.ListImages.Add(, strTemp1, LoadPicture(CurrentProject.Path &  "\"  & strTemp))
        obj.Tag =  "иконка на диске" 
        strTemp = Dir()
    Wend
    strTemp = Dir(CurrentProject.Path &  "\*.bmp" )
    While Len(strTemp) >  0 
        strTemp1 = Right(strTemp, Len(strTemp) - InStrRev(strTemp,  "\" ))
        strTemp1 = Left(strTemp1, Len(strTemp1) -  4 )
        Set obj = MyImageList.ListImages.Add(, strTemp1, LoadPicture(CurrentProject.Path &  "\"  & strTemp))
        obj.Tag =  "рисунок *.bmp на диске" 
        strTemp = Dir()
    Wend
    
End Function