PDA

View Full Version : MoveLast ERROR


dc888
06-29-2022, 04:20 AM
Dear all,

I have a problem with this code (since 1 month ago). There are problems with the MoveLast and MoveFirst function and I have been looking for it about 4 weeks ago and no solution, so please if you can help me :)




Sub ImportarModelos()
Dim strSource As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim consulta As String
Dim archivoAbrir As Excel.Workbook
Dim RUTAExcel As String
Dim strRespuesta As String
Dim posicionhoja As Integer
Dim rangocopiar As Range
Dim rangopegar As Range
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim cantcarroc As Long
Dim matrizcarroc(150) As String
Dim ETYPE As String
Dim modelo As String
Static cantmodelos As String
Dim planta As String
Dim numMES1 As Integer
Dim numMES2 As Integer
Dim numMES3 As Integer
Dim numMES4 As Integer
Dim numMES5 As Integer
Dim numMES6 As Integer
Dim numMES7 As Integer
Dim numMES8 As Integer
Dim numMES9 As Integer
Dim numMES10 As Integer
Dim numMES11 As Integer
Dim numMES12 As Integer
Dim StartTime As Double
Dim MinutesElapsed As String
strRespuesta = MsgBox("La importación de Modelos eliminará todos los datos anteriores. ¿Desea continuar?", _
vbQuestion + vbYesNo, "Importación de Modelos")
If strRespuesta = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'Colocar ACT y FC en la Plantilla
Call Etiquetar_FC_ACT
'Ruta Excel con rutas almacenadas (Excel formulario cargar ficheros)
RUTAExcel = RutaTool.Range("D2") & "" & RutaTool.Range("C2")
Set archivoAbrir = Workbooks.Open(RUTAExcel)
'Ruta bbdd
With archivoAbrir
strSource = ActiveSheet.Range("D6").Value & "" & ActiveSheet.Range("C6").Value
.Close
End With
Set dbs = DBEngine.OpenDatabase(strSource, False, False)
sFechaBotonModelos = "UPDATE Fechas_Modelos SET Fecha_BotonModelos= Now()"
dbs.Execute sFechaBotonModelos
'Aviso de ejecucion importar datos
Application.StatusBar = "Importando MODELOS desde Base de Datos"
marca = indice.Range("B10")
If marca = "TODAS" Then
consulta = "SELECT DISTINCT ModelosBD.E_CS " _
& "FROM ModelosBD " _
& "WHERE (((ModelosBD.Modelcode) In (SELECT Modelcode FROM [InvoicesAG]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_NSCStock]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_DealerStock]) " _
& "OR (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_CC) " _
& "OR (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_RAC) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasCC) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasRAC) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [WholesaleTOTAL]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [IncomingORDERS]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [RetailTOTAL])))"
Else
consulta = "SELECT DISTINCT ModelosBD.E_CS " _
& "FROM ModelosBD " _
& "WHERE (((ModelosBD.Brand)='" & marca & "') AND ((ModelosBD.Modelcode) In (SELECT Modelcode FROM [InvoicesAG]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_NSCStock]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_DealerStock]) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_CC) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_RAC) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasCC) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasRAC) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [WholesaleTOTAL]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [IncomingORDERS]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [RetailTOTAL])))"
End If
Set rst = dbs.OpenRecordset(consulta)
rst.MoveLast <---------- error
rst.MoveFirst <---------- error
cantcarroc = rst.RecordCount
For i = 1 To cantcarroc
matrizcarroc(i) = rst.Fields(0)
rst.MoveNext
Next i
'** para modelos, elimina todas las hojas y crea nueva por cada carrocería (para WH,RT e IO no elimina hojas)
canthojas = Worksheets.Count
If canthojas > 14 Then
For m = canthojas To 15 Step -1 'PARA CADA HOJA
Sheets(m).Delete
Next
End If 'canthojas >14
Sheets(3).Visible = True 'NuevaPlantilla
For m = 1 To cantcarroc
Sheets(3).Copy after:=Sheets(14) 'copia la hoja Plantilla (oculta)
Next m
Sheets(3).Visible = False
For i = 1 To cantcarroc
arnelgp
06-29-2022, 04:44 AM
check if there is at least a record fetched by the recordset:


Set rst = dbs.OpenRecordset(consulta)
If not (rst.BOF and rst.EOF) Then
.MoveLast
.MoveFirst
'continue with the code
Else
'the recordset is empty
Msgbox "No record was found!"
End If
rst.Close
set rst = Nothing
dc888
06-29-2022, 04:50 AM
I get the message: No record was found!

I dont know too much about VBA, but I put your code like this:


Sub ImportarModelos()
Dim strSource As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim consulta As String
Dim archivoAbrir As Excel.Workbook
Dim RUTAExcel As String
Dim strRespuesta As String
Dim posicionhoja As Integer
Dim rangocopiar As Range
Dim rangopegar As Range
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim cantcarroc As Long
Dim matrizcarroc(150) As String
Dim ETYPE As String
Dim modelo As String
Static cantmodelos As String
Dim planta As String
Dim numMES1 As Integer
Dim numMES2 As Integer
Dim numMES3 As Integer
Dim numMES4 As Integer
Dim numMES5 As Integer
Dim numMES6 As Integer
Dim numMES7 As Integer
Dim numMES8 As Integer
Dim numMES9 As Integer
Dim numMES10 As Integer
Dim numMES11 As Integer
Dim numMES12 As Integer
Dim StartTime As Double
Dim MinutesElapsed As String
strRespuesta = MsgBox("La importación de Modelos eliminará todos los datos anteriores. ¿Desea continuar?", _
vbQuestion + vbYesNo, "Importación de Modelos")
If strRespuesta = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'Colocar ACT y FC en la Plantilla
Call Etiquetar_FC_ACT
'Ruta Excel con rutas almacenadas (Excel formulario cargar ficheros)
RUTAExcel = RutaTool.Range("D2") & "" & RutaTool.Range("C2")
Set archivoAbrir = Workbooks.Open(RUTAExcel)
'Ruta bbdd
With archivoAbrir
strSource = ActiveSheet.Range("D6").Value & "" & ActiveSheet.Range("C6").Value
.Close
End With
Set dbs = DBEngine.OpenDatabase(strSource, False, False)
sFechaBotonModelos = "UPDATE Fechas_Modelos SET Fecha_BotonModelos= Now()"
dbs.Execute sFechaBotonModelos
'Aviso de ejecucion importar datos
Application.StatusBar = "Importando MODELOS desde Base de Datos"
marca = indice.Range("B10")
If marca = "TODAS" Then
consulta = "SELECT DISTINCT ModelosBD.E_CS " _
& "FROM ModelosBD " _
& "WHERE (((ModelosBD.Modelcode) In (SELECT Modelcode FROM [InvoicesAG]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_NSCStock]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_DealerStock]) " _
& "OR (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_CC) " _
& "OR (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_RAC) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasCC) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasRAC) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [WholesaleTOTAL]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [IncomingORDERS]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [RetailTOTAL])))"
Else
consulta = "SELECT DISTINCT ModelosBD.E_CS " _
& "FROM ModelosBD " _
& "WHERE (((ModelosBD.Brand)='" & marca & "') AND ((ModelosBD.Modelcode) In (SELECT Modelcode FROM [InvoicesAG]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_NSCStock]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_DealerStock]) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_CC) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_RAC) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasCC) " _
& "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasRAC) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [WholesaleTOTAL]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [IncomingORDERS]) " _
& "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [RetailTOTAL])))"
End If
Set rst = dbs.OpenRecordset(consulta)
If Not (rst.BOF And rst.EOF) Then
rst.MoveLast
rst.MoveFirst
Else
'the recordset is empty
MsgBox "No record was found!"
End If
rst.Close
Set rst = Nothing
cantcarroc = rst.RecordCount
For i = 1 To cantcarroc
matrizcarroc(i) = rst.Fields(0)
rst.MoveNext
Next i
'** para modelos, elimina todas las hojas y crea nueva por cada carrocería (para WH,RT e IO no elimina hojas)
canthojas = Worksheets.Count
If canthojas > 14 Then
For m = canthojas To 15 Step -1 'PARA CADA HOJA
Sheets(m).Delete
Next
End If 'canthojas >14
Sheets(3).Visible = True 'NuevaPlantilla
For m = 1 To cantcarroc
Sheets(3).Copy after:=Sheets(14) 'copia la hoja Plantilla (oculta)
Next m
Sheets(3).Visible = False
For i = 1 To cantcarroc
arnelgp
06-29-2022, 05:07 AM
if there is No Record, what will you do?
i think you need to Stop and Exit the Sub.



Sub ImportarModelos()
Dim strSource As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim consulta As String
Dim archivoAbrir As Excel.Workbook
Dim RUTAExcel As String
Dim strRespuesta As String
Dim posicionhoja As Integer
Dim rangocopiar As Range
Dim rangopegar As Range
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim cantcarroc As Long
Dim matrizcarroc(150) As String
Dim ETYPE As String
Dim modelo As String
Static cantmodelos As String
Dim planta As String
Dim numMES1 As Integer
Dim numMES2 As Integer
Dim numMES3 As Integer
Dim numMES4 As Integer
Dim numMES5 As Integer
Dim numMES6 As Integer
Dim numMES7 As Integer
Dim numMES8 As Integer
Dim numMES9 As Integer
Dim numMES10 As Integer
Dim numMES11 As Integer
Dim numMES12 As Integer
Dim StartTime As Double
Dim MinutesElapsed As String
strRespuesta = MsgBox("La importación de Modelos eliminará todos los datos anteriores. ¿Desea continuar?", _
vbQuestion + vbYesNo, "Importación de Modelos")
If strRespuesta = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'Colocar ACT y FC en la Plantilla
Call Etiquetar_FC_ACT
'Ruta Excel con rutas almacenadas (Excel formulario cargar ficheros)
RUTAExcel = RutaTool.Range("D2") & "" & RutaTool.Range("C2")
Set archivoAbrir = Workbooks.Open(RUTAExcel)
'Ruta bbdd
With archivoAbrir
strSource = ActiveSheet.Range("D6").Value & "" & ActiveSheet.Range("C6").Value
.Close
End With
Set dbs = DBEngine.OpenDatabase(strSource, False, False)
sFechaBotonModelos = "UPDATE Fechas_Modelos SET Fecha_BotonModelos= Now()"
dbs.Execute sFechaBotonModelos
'Aviso de ejecucion importar datos
Application.StatusBar = "Importando MODELOS desde Base de Datos"
marca = indice.Range("B10")
If marca = "TODAS" Then
consulta = "SELECT DISTINCT ModelosBD.E_CS " _
& "FROM ModelosBD " _
& "WHERE (((ModelosBD.Modelcode) In " _
& "(SELECT Modelcode FROM [InvoicesAG] UNION ALL " _
& "SELECT Modelcode FROM [SOYModel_NSCStock] UNION ALL " _
& "SELECT Modelcode FROM [SOYModel_DealerStock] UNION ALL " _
& "SELECT Modelcode FROM WholesaleVO_CC UNION ALL " _
& "SELECT Modelcode FROM WholesaleVO_RAC UNION ALL " _
& "SELECT Modelcode FROM MatriculasCC UNION ALL " _
& "SELECT Modelcode FROM MatriculasRAC UNION ALL " _
& "SELECT Modelcode FROM [WholesaleTOTAL] UNION ALL " _
& "SELECT Modelcode FROM [IncomingORDERS] UNION ALL " _
& "SELECT Modelcode FROM [RetailTOTAL])))"
Else
consulta = "SELECT DISTINCT ModelosBD.E_CS " _
& "FROM ModelosBD " _
& "WHERE (((ModelosBD.Brand)='" & marca & "') AND ((ModelosBD.Modelcode) In " _
& "(SELECT Modelcode FROM [InvoicesAG] UNION ALL " _
& "SELECT Modelcode FROM [SOYModel_NSCStock] UNION ALL " _
& "SELECT Modelcode FROM [SOYModel_DealerStock] UNION ALL " _
& "SELECT Modelcode FROM WholesaleVO_CC UNION ALL " _
& "SELECT Modelcode FROM WholesaleVO_RAC UNION ALL " _
& "SELECT Modelcode FROM MatriculasCC UNION ALL " _
& "SELECT Modelcode FROM MatriculasRAC UNION ALL " _
& "SELECT Modelcode FROM [WholesaleTOTAL] UNION ALL " _
& "SELECT Modelcode FROM [IncomingORDERS] UNION ALL " _
& "SELECT Modelcode FROM [RetailTOTAL])))"
End If
Set rst = dbs.OpenRecordset(consulta)
If (rst.BOF And rst.EOF) Then
rst.Close
Set rst = Nothing
'the recordset is empty
MsgBox "No record was found!"
Exit Sub
Else
rst.MoveLast
rst.MoveFirst
cantcarroc = rst.RecordCount
For i = 1 To cantcarroc
matrizcarroc(i) = rst.Fields(0)
rst.MoveNext
Next i
'** para modelos, elimina todas las hojas y crea nueva por cada carrocería (para WH,RT e IO no elimina hojas)
canthojas = Worksheets.Count
If canthojas > 14 Then
For m = canthojas To 15 Step -1 'PARA CADA HOJA
Sheets(m).Delete
Next
End If 'canthojas >14
Sheets(3).Visible = True 'NuevaPlantilla
For m = 1 To cantcarroc
Sheets(3).Copy after:=Sheets(14) 'copia la hoja Plantilla (oculta)
Next m
Sheets(3).Visible = False
For i = 1 To cantcarroc
End If
dc888
06-29-2022, 05:17 AM
Did i put your code in the correct order? Only happened this error this month, i have been working witch that code since 2 years ago and all worked good.

What do you think i have to do?
dc888
06-29-2022, 05:22 AM
So i think the error in the code is before the movelast function
dc888
06-29-2022, 06:26 AM
Hello, thank you for your reply and sorry for not being able to explain the error. The macro is extracting data from current months in order to predict future months. The error message I get is the following: "An error '3021' has occurred at runtime: there is no active record" When it has been working correctly for months and no one has touched the code.
Aflatoon
06-29-2022, 06:43 AM
You need to look at your data. It's not a code error per se, it's that nothing is matching your criteria so you don't get any records back.
dc888
06-29-2022, 06:56 AM
Hello,


The data is correct, what's more, this process is done every month, and I have tried to do it again last month (which previously worked correctly) and now it doesn't work. I am afraid it is due to an update in the Office, but I am not able to find the error or the solution.
Aflatoon
06-30-2022, 02:38 AM
The fact is you are not getting any records returned from your query. Without your files, we can't even determine which of the queries is running, let alone why it isn't returning anything, so I'm afraid the debugging will have to be at your end.