Visual Basic - Desconecta al Insertar Registros de un RS

Buenas tardes a todos, tengo el siguiente problema, tengo un select que me devuelve mas o menos 95mil registros, cuando los quiero insertar en otra tabla por medio de un RS (Esto lo hago porque le hago varios calculos y evaluaciones a los registros), me desconecta cada 4 o 5 mil registros dandome el error de SERVER DOES NOT EXIST OR ACCESS DENIED, pulso debug y luego continuo del punto dende hizo el ultimo insert.

Gracias por su ayuda

Atentamente

has controlado que cuando este copiando los registros en el server no hayan apagado la pc?
atmente

No se puede desconcectar la pc ya que es un server y en la que se corre el proceso tampoco se desconecta, adjunto el codigo que ejecuta dicho RS

Sql = "SELECT PRODUCTO,POLIZA,AGENTE, " & vbCrLf & _
" SUM(P_MOVIMIENTO)MOV, SUM(P_NETA_DISTRIBUIDA) DIST, " & vbCrLf & _
" IDMES, ANIO, DIST_REASEGURO " & vbCrLf & _
" FROM TBL_DIST_REASEGURO_ALTAS " & vbCrLf & _
" WHERE ANIO = 2006 " & vbCrLf & _
" GROUP BY PRODUCTO,POLIZA,AGENTE,IDMES,ANIO,DIST_REASEGURO "

DoEvents
M_Vusuarios.RsSien.Open Sql
DoEvents
MueveValor

End Sub

Sub MueveValor()

Screen.MousePointer = 11

With RsSien
While Not .EOF
DoEvents
Reaseguro = !dist_reaseguro
P_Prod = !Mov
P_Cedida = !Dist
Poliza = !Poliza
Producto = !Producto
Agente = !Agente
Mes = !Idmes
Anio = !Anio
Inserta
.MoveNext
Wend
End With

M_Vusuarios.RsSien.Close

Screen.MousePointer = 0

End Sub

Sub Inserta()

DoEvents

Reten = 0
C_Parte = 0
Exc = 0
Facult = 0
FacultOb = 0

If Reaseguro = "Retencion" Then
Reten = P_Cedida
End If
If Reaseguro = "Cuota Parte" Then
C_Parte = P_Cedida
End If
If Reaseguro = "1er. Excedente" Then
Exc = P_Cedida
End If
If Reaseguro = "Primer Excedente" Then
Exc = P_Cedida
End If
If Reaseguro = "Facultativos" Then
Facult = P_Cedida
End If
If Reaseguro = "Facultativo Obligatorio" Then
FacultOb = P_Cedida
End If

DoEvents

SqlApl = " INSERT INTO TBL_DETALLE_BONO_PRODUEN " & vbCrLf & _
" VALUES " & vbCrLf & _
"('" & Producto & "'," & Poliza & "," & Agente & "," & vbCrLf & _
"'" & "PRODUCCION" & "'," & P_Prod & "," & Reten & "," & vbCrLf & _
" " & C_Parte & "," & Exc & "," & Facult & "," & vbCrLf & _
" " & FacultOb & "," & Mes & "," & Anio & ")"

M_Vusuarios.Cn.Execute SqlApl

Contador = Contador + 1

Label1.Caption = "Insertando el Registro # " & Contador

End Sub