Tengo el Siguiente Codigo donde las variables publicas
tienen el siguiente valor:
ProveedorFdms = "Provider=Microsoft.Jet.Oledb.4.0;
DataSource=c:\Unioncomm\FdSvr\Fdms.mdb"
Proveedor = "Provider=Microsoft.Jet.Oledb.4.0; Data
Source=c:\Mis Documentos\Virdi\Datos.mdb"
Cursor = adOpenKeyset
Bloqueo = adLockOptimistic
Cuando ejecuto esta función access a veces, no todo el
tiempo me devuelve el siguiente error: SE HA PRODUCIDO EL
ERROR '2147217887 (80040E21)' EN TIEMPO DE EJECUCION. NO
SE PUEDE ACTUALIZAR, ACTUALMENTE ESTE ELEMENTO ESTA
BLOQUEADO. ESTO PASA EN LA LINEA DE .UPDATE DE RSMYTABLE4
DEL CODIGO. POR FAVOR SI SABES A QUE SE DEBE ESTE ERROR
AVISAME. GRACIAS WILMER DE VZLA.
Private Sub Transferir()
Dim Rsmytable1 As New ADODB.Recordset
Dim Rsmytable2 As New ADODB.Recordset
Dim Rsmytable3 As New ADODB.Recordset
Dim Rsmytable4 As New ADODB.Recordset
Dim Conr As Integer, nI As Integer
Rsmytable1.ActiveConnection = ProveedorFdms
Rsmytable2.ActiveConnection = Proveedor
Rsmytable3.ActiveConnection = Proveedor
Rsmytable4.ActiveConnection = Proveedor
Rsmytable1.Open "TblTtpu", _
Proveedor _
, Cursor, Bloqueo, adCmdTable
Rsmytable2.Open "SELECT * FROM Enter " & _
"WHERE (e_status = 0) And (e_result = 'O') ORDER
BY e_date, e_time", ProveedorFdms _
, Cursor, Bloqueo
Rsmytable3.Open "SELECT * FROM TblEmpleadosG " & _
"WHERE Cond_Empg = 1", Proveedor _
, Cursor, Bloqueo
Rsmytable4.Open "TblTtpu1", _
Proveedor _
, Cursor, Bloqueo, adCmdTable
If Rsmytable1.RecordCount > 0 Then
Rsmytable1.MoveFirst
Do
Rsmytable1.Delete adAffectCurrent
Rsmytable1.MoveNext
Loop Until Rsmytable1.EOF
End If
If Rsmytable2.EOF = True Then
MsgBox "No Hay Registros que Descargar", vbOKOnly,
Version
Exit Sub
End If
MsgBox "Descargando Registros", vbInformation, Version
Conr = 1
Me.CtrlActiveX52.Min = 0
Me.CtrlActiveX52.Max = Rsmytable2.RecordCount
Rsmytable2.MoveFirst
'Actualizamos la lista
'*********************
nI = 1
Do
Rsmytable3.MoveFirst
Rsmytable3.Find ("Cedu_Empg = " & Rsmytable2.Fields
("e_id"))
If Not Rsmytable3.EOF Then
With Rsmytable1
.AddNew
.Fields("NoVirdi") = Rsmytable2.Fields
("g_id")
.Fields("CodMovi") = Rsmytable2.Fields
("e_mode")
.Fields("CedEmpg") = Rsmytable2.Fields
("e_id")
.Fields("HoraMovi") = FormatDateTime(Mid
(Rsmytable2.Fields("e_time"), 1, 2) + ":" + Mid
(Rsmytable2.Fields("e_time"), 3, 2) + ":" + Mid
(Rsmytable2.Fields("e_time"), 5, 2), vbShortTime)
.Fields("FechaMovi") = FormatDateTime(Mid
(Rsmytable2.Fields("e_date"), 7, 2) + "/" + Mid
(Rsmytable2.Fields("e_date"), 5, 2) + "/" + Mid
(Rsmytable2.Fields("e_date"), 1, 4), vbShortDate)
.Update
End With
With Rsmytable2
.Fields("e_result") = "1"
.Fields("e_status") = True
.Update
End With
With Rsmytable4
.AddNew
.Fields("NoVirdi") = Rsmytable2.Fields
("g_id")
.Fields("CodMovi") = Rsmytable2.Fields
("e_mode")
.Fields("CedEmpg") = Rsmytable2.Fields
("e_id")
.Fields("HoraMovi") = FormatDateTime(Mid
(Rsmytable2.Fields("e_time"), 1, 2) + ":" + Mid
(Rsmytable2.Fields("e_time"), 3, 2) + ":" + Mid
(Rsmytable2.Fields("e_time"), 5, 2), vbShortTime)
.Fields("FechaMovi") = FormatDateTime(Mid
(Rsmytable2.Fields("e_date"), 7, 2) + "/" + Mid
(Rsmytable2.Fields("e_date"), 5, 2) + "/" + Mid
(Rsmytable2.Fields("e_date"), 1, 4), vbShortDate)
.Update
End With
nI = nI + 1
End If
DoCmd.Echo True, "Descargando Registro: " + CStr
(Conr)
Me.CtrlActiveX52.Value = Conr
Rsmytable2.MoveNext
Conr = Conr + 1
Loop Until Rsmytable2.EOF
Rsmytable1.Close
Rsmytable2.Close
Rsmytable3.Close
Rsmytable4.Close
End Sub
Leer las respuestas