Programa se cuelga

[kalvera85]

Hola compañeros ojala y mi problema tenga solución, relice un programa que se conecta mediante DSN a una base de datos que esta en un servidor Local y aparte se conecta por codigo a una base de datos ubicada en la PC donde trabaja el programa, este programa reliza la tarea de agregar los datos contenidos en la tabla del servidor Local a una tabla contenida en la base de datos que esta en la maquina donde esta trabajando el software, el programa realiza bien su función, pero el problema es que mientras lo estoy ejecutando no puedo hacer nada en la computadora ya que si intento hacer algo el programa se traba y tengo que reiniciarlo, mi pregunta es existe alguna manera de evitar que se trabe el programa.

Por favor les pido ayuda la verdad es que he intentado de todo y nada me ha ayudado , de antemano muchas GRACIAS

aqui le dejo el codigo que estoy utlizando, abe mencionar que lo desarrolle en Visual Basic 6.0 y las conexiones a las bases de datos son mediante ADODC y la informacion la muestro en datagrids.

Código:

Private Sub Command1_Click()
    C2.Filter = "Base de Datos Microsoft Access | *.mdb"
    C2.ShowOpen
    Text4.Text = C2.FileName
End Sub

Private Sub Command2_Click()
Dim Connectionstring As String
If Text4.Text = "" Or Text4.Text = "Selecciona una base de datos de Microsoft Access" Then
MsgBox "Seleccione una base de datos válida", vbExclamation, "IMPORTANTE !!!"
Else
Connectionstring = "Driver={Microsoft Access Driver (*.mdb)};" & _
   "Dbq=" & Text4.Text & ";" & "Uid=;Pwd="
   
With ado1
    .RecordSource = "Select * from consultas_internet"
    .Connectionstring = Connectionstring
    .Refresh
    .Visible = False
End With

Set DataGrid1.DataSource = ado1
ado1.Recordset.MoveFirst
DoEvents
Command3.Enabled = True
End If

End Sub

Private Sub Command3_Click()
Adodc1.Recordset.MoveFirst
Adodc2.Recordset.MoveFirst
ado1.Recordset.MoveFirst

If Not Adodc1.Recordset.BOF Then
    Adodc1.Recordset.MoveFirst
End If
If Not Adodc2.Recordset.BOF Then
    Adodc2.Recordset.MoveFirst
End If
If Not ado1.Recordset.BOF Then
    ado1.Recordset.MoveFirst
End If

barra.Value = 0
barra.Max = Adodc1.Recordset.RecordCount
X = barra.Max / Adodc1.Recordset.RecordCount

'EXAMINA LA TABLA

While Not Adodc1.Recordset.EOF
    csql = "correo= '" & Adodc1.Recordset!correoel & "'"
    csql2 = "estado= '" & Adodc1.Recordset!estado & "'"
    Adodc2.Recordset.Find csql2
    ado1.Recordset.Find csql
    
    
    If Adodc1.Recordset!correoel <> "" Then
        If ado1.Recordset.EOF Then
            ado1.Recordset.AddNew
            ado1.Recordset!nombres = Adodc1.Recordset!nombres
            ado1.Recordset!apaterno = Adodc1.Recordset!apepat
            ado1.Recordset!amaterno = Adodc1.Recordset!apemat
            ado1.Recordset!delegacion = Adodc1.Recordset!pobdelmun
            
            If Adodc2.Recordset!estado > 0 And Adodc2.Recordset!estado < 33 Then
                ado1.Recordset!estado = Adodc2.Recordset!descripcion
            Else
                ado1.Recordset!estado = ""
            End If
            
            ado1.Recordset!pais = "México"
            ado1.Recordset!reparacion_pc = "SI"
            ado1.Recordset!mecanica = "SI"
            ado1.Recordset!mecatronica = "SI"
            ado1.Recordset!electronica = "SI"
            ado1.Recordset!estatus = "A"
            ado1.Recordset!modulo = "SP"
            ado1.Recordset!correo = Adodc1.Recordset!correoel
        Else
            If ado1.Recordset!nombres <> Adodc1.Recordset!nombres Then
                ado1.Recordset!nombres = Adodc1.Recordset!nombres
                ado1.Recordset.Update
            End If
            If ado1.Recordset!apaterno <> Adodc1.Recordset!apepat Then
                ado1.Recordset!apaterno = Adodc1.Recordset!apepat
                ado1.Recordset.Update
            End If
            If ado1.Recordset!amaterno <> Adodc1.Recordset!apemat Then
                ado1.Recordset!amaterno = Adodc1.Recordset!apemat
                ado1.Recordset.Update
            End If
            If ado1.Recordset!delegacion <> Adodc1.Recordset!pobdelmun Then
                ado1.Recordset!delegacion = Adodc1.Recordset!pobdelmun
                ado1.Recordset.Update
            End If
            If ado1.Recordset!estado <> Adodc2.Recordset!descripcion Then
                If Adodc2.Recordset!estado > 0 And Adodc2.Recordset!estado < 33 Then
                    ado1.Recordset!estado = Adodc2.Recordset!descripcion
                Else
                    ado1.Recordset!estado = ""
                End If
                ado1.Recordset.Update
            End If
            If ado1.Recordset!pais <> "México" Then
                ado1.Recordset!pais = "México"
                ado1.Recordset.Update
            End If
            If ado1.Recordset!reparacion_pc <> "SI" Then
                ado1.Recordset!reparacion_pc = "SI"
                ado1.Recordset.Update
            End If
            If ado1.Recordset!mecanica <> "SI" Then
                ado1.Recordset!mecanica = "SI"
                ado1.Recordset.Update
            End If
            If ado1.Recordset!mecatronica <> "SI" Then
                ado1.Recordset!mecatronica = "SI"
                ado1.Recordset.Update
            End If
            If ado1.Recordset!electronica <> "SI" Then
                ado1.Recordset!electronica = "SI"
                ado1.Recordset.Update
            End If
            If ado1.Recordset!estatus <> "A" Then
                ado1.Recordset!estatus = "A"
                ado1.Recordset.Update
            End If
            If ado1.Recordset!modulo <> "S" Then
                ado1.Recordset!modulo = "S"
                ado1.Recordset.Update
            End If
            If ado1.Recordset!correo <> Adodc1.Recordset!correoel Then
                ado1.Recordset!correo = Adodc1.Recordset!correoel
                ado1.Recordset.Update
            End If
        
        End If
            
        
    End If
    Adodc1.Recordset.MoveNext
    ado1.Recordset.MoveFirst
    Adodc2.Recordset.MoveFirst
    barra.Value = barra.Value + X
Wend
End Sub