Public d As New ADODB.Connection
Public r As New ADODB.Recordset
Public r1 As New ADODB.Recordset
Public t As New ADOX.Catalog
Public c As New ADODB.Command

Dim tbl As New ADOX.Table
Dim clmn As New ADOX.Column
Dim ind As New ADOX.Index
'
‘где-то должны быть настроены переменные d,r,r1,t,c на используемое соединение, что-то вроде
‘    varConnect = d.ConnectionString
‘    d.Open
‘    r.ActiveConnection = d.ConnectionString
‘    t.ActiveConnection = varConnect
‘

Private Sub cmdOKInsert_Click()
‘Ссылка на переключатели, позволяющие выбрать количество записей 
    If opt100 Then
        varN =  100 
    ElseIf opt1000 Then
        varN =  1000 
    ElseIf opt10000 Then
        varN =  10000 
    ElseIf opt100000 Then
        varN =  100000 
    End If
‘lstActiveTab    список таблиц,  вкоторые нужно внести записи
    For i =  0  To lstActiveTab.ListCount -  1 
'Удаление старых записей
        nametable = lstActiveTab.List(i)
        Set tbl = t.Tables(nametable)
        r.Open "select * from " & tbl.Name, varConnect, adOpenKeyset
        If r.RecordCount <>  0  Then
            If MsgBox("Удалять старые данные?", vbQuestion + vbYesNo) = vbYes Then
                c.CommandText = "delete * from " & nametable
                c.Execute
            Else
                n = r.RecordCount
                varN = IIf(n < varN, varN - n,  0 )
            End If
        End If
        r.Close
'Установка начальных значений
        s0 = ""
        s = ""
        
'Формирование начала оператора insert
        s0 = "insert into " & nametable & "("
        For j =  0  To tbl.Columns.Count -  1 
            s = s & tbl.Columns(j).Name & ","
        Next
        s = Mid(s,  1 , Len(s) -  1 )
'Формирование заданного количества строк для ввода в таблицы
        For k =  1  To varN
            s1 = ""
            For j =  0  To tbl.Columns.Count -  1 
                Set clmn = tbl.Columns(j)
'Проверка, не требуется ли уникальное значение для обрабатываемого поля
                flPrKey = False
                For l =  0  To tbl.Indexes.Count -  1 
                    Set ind = tbl.Indexes(l)
                    For ll =  0  To ind.Columns.Count -  1 
                        If ind.Columns(ll).Name = clmn.Name And (ind.PrimaryKey Or ind.Unique) Then
                            flPrKey = True
                        End If
                    Next
                Next
                
                If flPrKey Then
                    s1 = s1 & MyGenKey(clmn.Type, clmn.DefinedSize, clmn.Name, tbl.Name) & ","
                Else
                    s1 = s1 & MyGenData(clmn.Type, clmn.DefinedSize) & ","
                End If
            Next
'Выполнение оператора insert
            s1 = Mid(s1,  1 , Len(s1) -  1 )
            c.CommandText = s0 & s & ") values (" & s1 & ")"
'Debug.Print c.CommandText
            c.Execute
        Next
        r.Open "select * from " & tbl.Name, varConnect, adOpenKeyset
‘lstActiveQRec –список, отображающий количество записей в соответствующих таблицах
        lstActiveQRec.List(i) = r.RecordCount
        r.Close
    Next
    
End Sub

Public Function MyGenData(MyType As Long, MySize As Integer, n As Long) As String
    Randomize
    Select Case MyType
        Case adBigInt
            g = CStr(Int( 1000  * Rnd()))
        Case adInteger
            g = CStr(Int( 100  * Rnd()))
        Case adVarChar, adChar, adLongVarChar, adVarWChar, adWChar
            
            g = "'" & GenString(MySize) & "'"
        Case adDate
            g = "#" & Int( 11  * Rnd()) +  1  & "/" & Int( 28  * Rnd()) +  1  & "/" & Int(n * Rnd()) +  1  & "#"
            
        Case Else
            g = "null"
    End Select
    MyGenData = g

End Function

Public Function GenString(varSize As Integer) As String
    n = Int(varSize * Rnd())
    n = IIf(n =  0 ,  1 , n)
    For i =  1  To n
        Select Case Int( 3  * Rnd())
            Case  0 
                g = g & Chr(Asc("a") + Int( 26  * Rnd()))
            Case  1 
                g = g & Chr(Asc("A") + Int( 26  * Rnd()))
            Case  2 
                g = g & Chr(Asc("0") + Int( 10  * Rnd()))

        End Select
    Next
    GenString = g
End Function
Public Function MyGenKey(MyType As Long, MySize As Integer, p As String, tt As String, gg As Long) As String
    Select Case MyType
        Case adBigInt, adInteger
            g = gg +  1 
        Case adVarChar, adChar
            Do
                g = "'" & GenString(MySize) & "'"
                r1.Open "select count(*) from " & tt & " where " & p & "=" & g, , adOpenStatic, adLockReadOnly
                n = r1.RecordCount
                r1.Close
            Loop Until n =  0 
        Case adDate
            
            g = "#" & CStr(CDate(gg) +  1 ) & "#"
            
        Case Else
            g = "null"
    End Select
    MyGenKey = g

End Function