Försök till första VB program...;o)

Hej!
Håller på å gör ett program som skall kolla i en databas en gång varje jämn 10:onde minut t.ex. 10.10 10.20 o.s.v. När den sedan hittar poster så skall den maila till den berörda.
Programmet skall samtidigt skriva ut lite info om vad det gör. Problemet är att datorn får upp i 100% processoranvändning och fönstret kommer inte upp, vad kan vara fel, och vad kan förbättras. Inte säker på om allting funkar. Är van ASP kodare så jag är ingen nybörjare på programmering i övrigt.

Koden

Private Sub Form_Load()
    Text1 = "Ansluter till databasen..." & vbCrLf
    Dim connect, recset As Object
    
    Set connect = CreateObject("ADODB.Connection")
    connect.Open "driver={MySQL ODBC 3.51 Driver};server=localhost;uid=b001;pwd=pawqzz;database=b001"

    Text1 = Text1 & "Anslutningen upprättad..." & vbCrLf & vbCrLf
    
    If Not Left(Time(), 5) = "" & DatePart("h", Time()) & ":" & DatePart("m", Time()) & "" Then
        Dim tid As String
        tid = Time()
        If Left(tid, 4) = "5" Then
            If Left(tid, 2) = "23" Then
                tid = "00"
            Else
                tid = Left(tid, 2) + 1
            End If
            
            tid = tid & ":00:00"
            
            Dim arrTid
            arrTid = Split(tid, ":")
            
            If Len(arrTid) = 1 Then
                tid = 0 & tid
            End If
            
            Dim ms As String
            ms = DateDiff("s", Time(), tid) / 1000
            
            thread.sleep (ms)
    End If
    
    Do While 1 = 1
        Set recset = connect.execute("SELECT * FROM kalender_paminnelse WHERE datum = '" & Date & "' AND tid = '" & Left(Time(), 5) & "'")
        
        If recset.EOF Then
            Text1 = Text1 & Time() & vbCrLf & "----Inga poster hittade----" & vbCrLf
        Else
            Dim medd As String
            Dim mail, recset2, recset3 As Object
            Do Until recset.EOF
                Text1 = Text1 & Time() & vbCrLf & "***Post(er) hittade***" & vbCrLf
                
                Set recset2 = connect.execute("SELECT * FROM kalender_users WHERE id = '" & recset(4) & "'")
                Set recset3 = connect.execute("SELECT * FROM kalender_uppgifter WHERE id = '" & recset(1) & "'")
                
                jamil = CreateObject("Jmail.Message")
                jmail.logging = True
                
                jmail.From = "info@veckoplaneraren.no-ip.com"
                jmail.FromName = "Veckoplaneraren"
                jmail.AddRecipient = "" & recset2(2) & ""
                jmail.subject = "Påminnelse"
                
                medd = "<font face=verdana size=1 color='#000000'>"
                medd = medd & "<strong>Påminnelse från Veckoplaneraren!</strong><br/>"
                medd = medd & "Då får detta mail eftersom du har valt att få en påminnelse om<br/>"
                medd = medd & "en händelse som d lagt in på veckoplaneraren.<br/><br/>"
                medd = medd & "<strong>" & recset3(1) & " - " & recset3(2) & "</strong><br/>"
                medd = medd & recset(3) & "<br/><br/>"
                medd = medd & "Med Vänliga Hälsningar<br/>"
                medd = medd & "//Veckoplaneraren<br/>"
                
                jmail.appendHTML "" & medd & ""
    
                jmail.Send ("127.0.0.1")
                Set jmail = Nothing
                
                Text1 = Text1 & "Skickar mail till" & recset2(1) & " på adressen " & recset2(2) & "..." & vbCrLf
                Text1 = Text1 & "---------------------------------------------------------------------" & vbCrLf
                Text1 = Text1 & Replace(medd, "<br/>", "<br/>bCrLf")
                Text1 = Text1 & "---------------------------------------------------------------------" & vbCrLf & vbCrLf
                
                recset3.Close
                Set recset3 = Nothing
                recset2.Close
                Set recset2 = Nothing
            Loop
        End If
    Loop
    End If
End Sub

Hoppas att ni kan hjälpa till!

Tacksam för svar!