При загрузке объявляю новую переменную:
Private Th1 As New System.Threading.Thread(AddressOf seachdoc)
затем запускаю отдельный поток
Th1.Start()
Листинт процедуры
- Код: Выделить всё
Private Sub seachdoc()
Dim bCount As Short
Dim iCount As Short
Dim KeyNum As Short
Dim KeyNumD As Short
Dim KeyName As Object
Dim KeyNameD As Object
Dim KeyValue As String
Dim KeyValueD As String
Dim shtamp As String
Dim i As Integer
On Error GoTo ErrLb
KeyNameD = Nothing
KeyName = Nothing
'Создание экземпляра SQL-DMO
oSQLServer2 = New SQLDMO.SQLServer
oSQLServer2.LoginSecure = False
oSQLServer2.ApplicationName = "SQL-DMO Seach"
'Цикл пока пользователь не остановит
Do While opros.Checked = True
oSQLServer2.Connect(VBGetPrivateProfileString("connection", "server", FileName), VBGetPrivateProfileString("connection", "login", FileName), VBGetPrivateProfileString("connection", "pass", FileName))
oSQLServer2.Application.GroupRegistrationServer = ""
KeyNum = GetKeyNames("databases", FileName, KeyName)
For bCount = 0 To KeyNum
KeyValue = VBGetPrivateProfileString("databases", VB6.Format(KeyName(bCount)), FileName)
oCurDB2 = oSQLServer2.Databases.Item(KeyValue)
KeyNumD = GetKeyNames("documents", FileName, KeyNameD)
shtamp = Mid(VBGetPrivateProfileString(KeyValue, "shtamp", FileName), 7, 4) & Mid(VBGetPrivateProfileString(KeyValue, "shtamp", FileName), 4, 2) & Mid(VBGetPrivateProfileString(KeyValue, "shtamp", FileName), 1, 2) & Mid(VBGetPrivateProfileString(KeyValue, "shtamp", FileName), 11)
For iCount = 0 To KeyNumD
KeyValueD = VBGetPrivateProfileString("documents", VB6.Format(KeyNameD(iCount)), FileName)
oResult2 = oCurDB2.ExecuteWithResults("SELECT CLIENT AS Expr1, COUNT(CLIENT) AS Expr2 from [" & oCurDB2.Tables.Item(1).Owner & "].[" & Mid(KeyValueD, InStrRev(KeyValueD, vbTab) + 1, Len(KeyValueD) - (InStrRev(KeyValueD, vbTab))) & "]" & " WHERE (CLIENT IN" & VBGetPrivateProfileString(KeyValue, "clients", FileName) & ") and (DATETIMERECEIVE >" & "convert(datetime, '" & shtamp & "')) GROUP BY CLIENT")
If oResult2.Rows > 0 Then
For i = 1 To oResult2.Rows
DataGridView1.Invoke(New DelegateWithStringSignature(AddressOf AddRow), Mid(VBGetPrivateProfileString("clients", KeyValue & oResult2.GetColumnString(i, 1), FileName), InStrRev(VBGetPrivateProfileString("clients", KeyValue & oResult2.GetColumnString(i, 1), FileName), vbTab) + 1), Mid(KeyValueD, InStr(1, KeyValueD, vbTab) + 1, InStrRev(KeyValueD, vbTab) - InStr(1, KeyValueD, vbTab) - 1), oResult2.GetColumnString(i, 2))
Next
label2.Invoke(New MethodInvoker(AddressOf LebVis))
BallonMess(1, "Внимание!!!", "Поступили новые документы!", 1)
End If
Next
Next
If snd.Checked = True Then
PlaySound()
End If
KeyNum = GetKeyNames("databases", FileName, KeyName)
For bCount = 0 To KeyNum
KeyValue = VBGetPrivateProfileString("databases", VB6.Format(KeyName(bCount)), FileName)
If WriteKey(KeyValue, "shtamp", VB6.Format(Today, "DD.MM.YYYY") & " " & TimeString, FileName)<>0 then
MsgBox("Не удалось открыть ini файл")
End If
Next
oCurDB2 = Nothing
oResult2 = Nothing
oSQLServer2.DisConnect()
System.Threading.Thread.Sleep(15000)
Loop
oSQLServer2.Close()
Exit Sub
ErrLb:
PrintError()
End Sub
Подскажите что не так.
Заранее извините за плохо читаемый код
