Public Sub Doing()
Dim sql As String
 Dim result As ADODB.Recordset
 Dim cn As ADODB.Connection
 Set cn = CreateObject("ADODB.Connection")
 '   Set cn = New ADODB.Connection
    With cn
        .Provider = "SQLOLEDB"
        .CommandTimeout =  0 
        .Properties("User Id") = "***"
        .Properties("Password") = "***"
        .Properties("Data Source") = "***"
        .Properties("Persist Security Info") = True
        .Open
        .DefaultDatabase = "**"
    End With
  '  Dim result As ADODB.Recordset
  sql = "Select * from [send&rec]"
  Set result = CreateObject("ADODB.recordset")
 ' With result
  result.Open sql, cтn

Private Sub cmdStart_Click()

    Dim lpThreadID As Long
cmdClose.Visible = False
    lThreadHandle1 = CreateThread(ByVal  0 &, _
                ByVal  0 &, _
                AddressOf Doing, _
                ByVal  0 &,  0 , lpThreadID)
    lEventHandle = CreateEvent(ByVal  0 &, _
                False, False, ByVal  0 &)

End Sub

Public Sub Doing()

Dim sql As String
 Dim result As ADODB.Recordset
 Dim con As Object
 Dim i As Long
 i =  0 
 Set con = CreateObject("ADODB.Connection")
 With con
        .Provider = "SQLOLEDB"
        .CommandTimeout =  0 
        .Properties("User Id") = "popkov"
        .Properties("Password") = "12589"
        .Properties("Data Source") = "KHD"
        .Properties("Persist Security Info") = True
        .Open
        .DefaultDatabase = "mg"
    End With
  Set result = New ADODB.Recordset
  sql = "Select * from [send&rec]"
  result.Open sql, con
  Set con = Nothing
Set result = Nothing
End Sub

Option Explicit
Public Declare Function CreateThread Lib "kernel32" _
            (ByVal lpThreadAttributes As Any, _
            ByVal dwStackSize As Long, _
            ByVal lpStartAddress As Long, _
            lpParameter As Any, _
            ByVal dwCreationFlags As Long, _
            lpThreadID As Long) As Long

Public Declare Sub Sleep Lib "kernel32" _
            (ByVal dwMilliseconds As Long)

Public Declare Function TerminateThread Lib "kernel32" _
            (ByVal hThread As Long, _
            ByVal dwExitCode As Long) As Long

Public Declare Function TerminateProcess Lib "kernel32" _
            (ByVal hProcess As Long, _
            ByVal uExitCode As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function CreateEvent& Lib "kernel32" _
            Alias "CreateEventA" _
            (ByVal lpEventAttributes As Long, _
            ByVal bManualReset As Long, _
            ByVal bInitialState As Long, _
            ByVal lpname As String)
Public lThreadHandle1 As Long
'Public lThreadHandle2 As Long
Public lEventHandle As Long
Public Sub Doing()
Dim sql As String
 Dim result As Object
 Dim con As Object
 Dim i As Long
 i =  0 
 Set con = CreateObject("ADODB.Connection")
 With con
        .Provider = "SQLOLEDB"
        .CommandTimeout =  0 
        .Properties("User Id") = "***"
        .Properties("Password") = "***"
        .Properties("Data Source") = "***"
        .Properties("Persist Security Info") = True
        .Open
        .DefaultDatabase = "***"
    End With
  sql = "Select * from [send&rec]"
  Set result = CreateObject("ADODB.recordset")
  result.Open sql, con
  ' sql = "Select * from [Send&rec]"
If Not result.EOF Then
        result.MoveFirst
        While Not result.EOF
        i = i +  1 
frmOutput.txtResult = Str(i)
result.MoveNext
        Wend
       Else
       frmOutput.Shape1.FillColor = &HFF00&
End If
Set con = Nothing
Set result = Nothing
End Sub

Public Sub Main()
    frmOutput.Show
End Sub

Private Sub cmdStart_Click()

    Dim lpThreadID As Long
cmdClose.Visible = False
    lThreadHandle1 = CreateThread(ByVal  0 &, _
                ByVal  0 &, _
                AddressOf Doing, _
                ByVal  0 &,  0 , lpThreadID)
    lEventHandle = CreateEvent(ByVal  0 &, _
                False, False, ByVal  0 &)

End Sub
Private Sub Form_Unload(Cancel As Integer)

    If lThreadHandle1 >  0  Then
        Call TerminateThread(lThreadHandle1, ByVal  0 &)
    End If

    Call TerminateProcess(GetCurrentProcess, ByVal  0 &)

End Sub
здеся че не так????