none
VBA Excel 2013 Error 3021 RRS feed

  • Pregunta

  • Hola a todos en esta maravillosa comunidad, pues resulta que tengo este codigo y me da el error " Se ha producido el error 3021: El valor de BOF o EOF es True, o el actual registro se elimino; la operacion solicitada requiere un registro actual." el codigo que uso es el siguiente:

    Public conn As ADODB.Connection
    Public dbRecset As ADODB.Recordset
    Public sSQL As String
    Public l As Long, l2 As Long
    Public rowtable As Integer
    Public height As Integer
    Public RunWhen As Double 
    Public Const cRunIntervalSeconds = 3
    Public Const cRunIntervalMinuts = 0
    Public Const cRunWhat = "SelectSQL"
    Public RunWhen2 As Double 
    Public Const cRunIntervalSeconds2 = 3  
    Public Const cRunIntervalMinuts2 = 0 
    Public Const cRunWhat2 = "InsertSQL" 
    
    Sub ConexcionDB()
        Set conn = New ADODB.Connection
        conn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" & _
                                "SERVER=localhost;" & _
                                "PORT=3306" & _
                                "DATABASE=pruebas;" & _
                                "UID=root;PASSWORD=123456789;OPTION=3"
    End Sub
    
    Sub SelectSQL()
        Call ConexcionDB
        
        sSQL = "select tblorigen.DescargaCBBA, tblorigen.DescargaSAY, tblorigen.DescargaCAR, tblorigen.CaudalCBBA, tblorigen.CaudalSAY, tblorigen.CaudalCAR from pruebas.tblorigen where tblorigen.id = 2;"
        conn.Open
        
        Set dbRecset = New ADODB.Recordset
        dbRecset.CursorLocation = adUseClient
         
        dbRecset.Open Source:=sSQL, ActiveConnection:=conn, CursorType:=adOpenForwardOnly, _
                      LockType:=adLockReadOnly, Options:=adCmdText
       
            dbRecset.MoveFirst 'ACA ME DA EL ERROR 3021
            
         For l2 = 1 To dbRecset.RecordCount
            For l = 1 To dbRecset.Fields.Count
                Worksheets(1).Cells(l2 + 1, l).Value = dbRecset.Fields(l - 1).Value
            Next l
            dbRecset.MoveNext
        Next l2
         
        dbRecset.Close
        conn.Close
        Call CerrarConnx
        
        TimerSelectOn
    End Sub
    
    Sub InsertSQL()
    
        Set dbRecset = New ADODB.Recordset
        Call ConexcionDB
             
        conn.Open
    
        height = Worksheets("Insertar").UsedRange.Rows.Count
    
        With Worksheets("Insertar")
        
        For rowtable = 2 To height
        sSQL = "insert into pruebas.tbldestino (tbldestino.Kilometro, tbldestino.Haltura, tbldestino.Presion) " & _
        "values ('" & (.Cells(rowtable, 1).Value) & "', '" & _
                (.Cells(rowtable, 2).Value) & "', '" & _
                (.Cells(rowtable, 3).Value) & "')"
                dbRecset.Open sSQL, conn ',adOpenDynamic, adLockOptimistic
        Next rowtable
        End With
    
        If Err.Description <> "" And Err.Source <> "" Then
        MsgBox Err.Description, vbCritical, Err.Source
        End If
        conn.Close
        Call CerrarConnx
        
        TimerInsertOn
    End Sub
    
    Sub CerrarConnx()
        'conn.Close
        Set dbRecset = Nothing
        Set conn = Nothing
    End Sub
    
    Sub TimerSelectOn()
        Range("A1").Interior.ColorIndex = 4
        RunWhen = Now + TimeSerial(0, cRunIntervalMinuts, cRunIntervalSeconds)
        Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=True
    End Sub
    
    Sub TimerSelectOff()
        Range("A1").Interior.ColorIndex = 2
        On Error Resume Next
        Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=False
    End Sub
    
    Sub TimerInsertOn()
        Range("A1").Interior.ColorIndex = 4
        RunWhen2 = Now + TimeSerial(0, cRunIntervalMinuts2, cRunIntervalSeconds2)
        Application.OnTime EarliestTime:=RunWhen2, Procedure:=cRunWhat2, _
        Schedule:=True
    End Sub
    
    Sub TimerInsertOff()
        Range("A1").Interior.ColorIndex = 2
        On Error Resume Next
        Application.OnTime EarliestTime:=RunWhen2, Procedure:=cRunWhat2, _
        Schedule:=False
    End Sub

    Este codigo ya se usabla en office 2016 y no daba ningun error, pero el ordenador en el que iba funcionar resulto tener Windows 2012R2 y no lo sabia, pero la instalacion de office 2016 resulto ser todo un problema, al final despues de tantos mensajes de error decidimos probar con office 2013 esa version si lo acepto, pero ahora el problema es que me da este error.

    Aprecio mucho su valiosa ayuda amigos.

    Saludos.

    viernes, 25 de noviembre de 2016 19:25