Validar Importación Datos
Ante todo reciban mis cordiales saludos. Necesito validar la importación de datos, que cuando ejecute el código, y no encuentre la Tabla RE1, ya no me muestre mensaje de error, si existe que exporte los datos.
Dim Fila&, filainicio&, ultimafila$, columnacampo As Byte
Dim Query As String
Dim row As Double
Dim rstdata() As Variant
Set cn = New ADODB.Connection
With cn
.provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Data Source=C:\BD_Produccion\RE2009M2.mdb"
.Open
End With
Set rst = New ADODB.Recordset
Query = "Select FechaRemito,CodAsociado,Cliente,NOMAR1,NOMAR2,NOMAR3,NOMCE1,NOMCE2,NOMAG1,NOMAD1,NOMAD2,RAR1,RAR2,RAR3,RCE1,RCE2,RAG1,RAD1,RAD2,M3Real,Anulado from RE1"
With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Query, cn, , , adCmdText
End With
rstdata = rst.GetRows
row = ActiveSheet.Range("A65536").End(xlUp).row
filainicio& = 2
For Fila& = 1 To UBound(rstdata, 2) + 1
For columnacampo = 1 To 21
If Not IsNull(rstdata(columnacampo - 1, Fila& - 1)) Then
Cells(filainicio&, columnacampo) = rstdata(columnacampo - 1, Fila& - 1)
End If
Next columnacampo
Cells(filainicio&, 1).Offset(1, 0).Select
filainicio& = filainicio& + 1
Next Fila&
rst.Close
cn.Close
Set rst = Nothing
Set cn = Nothing
Dim Fila&, filainicio&, ultimafila$, columnacampo As Byte
Dim Query As String
Dim row As Double
Dim rstdata() As Variant
Set cn = New ADODB.Connection
With cn
.provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Data Source=C:\BD_Produccion\RE2009M2.mdb"
.Open
End With
Set rst = New ADODB.Recordset
Query = "Select FechaRemito,CodAsociado,Cliente,NOMAR1,NOMAR2,NOMAR3,NOMCE1,NOMCE2,NOMAG1,NOMAD1,NOMAD2,RAR1,RAR2,RAR3,RCE1,RCE2,RAG1,RAD1,RAD2,M3Real,Anulado from RE1"
With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Query, cn, , , adCmdText
End With
rstdata = rst.GetRows
row = ActiveSheet.Range("A65536").End(xlUp).row
filainicio& = 2
For Fila& = 1 To UBound(rstdata, 2) + 1
For columnacampo = 1 To 21
If Not IsNull(rstdata(columnacampo - 1, Fila& - 1)) Then
Cells(filainicio&, columnacampo) = rstdata(columnacampo - 1, Fila& - 1)
End If
Next columnacampo
Cells(filainicio&, 1).Offset(1, 0).Select
filainicio& = filainicio& + 1
Next Fila&
rst.Close
cn.Close
Set rst = Nothing
Set cn = Nothing
1 respuesta
Respuesta de mrtool
1
1
mrtool, Con mas de 15 años de experiencia en consultoria informatica en...
Te he dejado un archivo con las macros en :
http://sites.google.com/site/expertmrtool/archvios-de-ayuda-para-msexcel/macros-excel
Solo tienes que cambiar la cadena de conexión y el hacer una vista o consulta para los datos que quieras recuperar ( aunque podrías hacer la query directamente).
El código es sencillo de cambiar y lanza un error si la tabla no existe.
Si tienes cuqluier prpblema comentamelo.
http://sites.google.com/site/expertmrtool/archvios-de-ayuda-para-msexcel/macros-excel
Solo tienes que cambiar la cadena de conexión y el hacer una vista o consulta para los datos que quieras recuperar ( aunque podrías hacer la query directamente).
El código es sencillo de cambiar y lanza un error si la tabla no existe.
Si tienes cuqluier prpblema comentamelo.
Hola. Ante todo gracias por brindarme tu ayuda, ya acople una linea de comando a mi código, en caso que no exista, la tabla en la base datos, gracias al archivo de excel que me enviaste, pude trabajar el manejo y control de errores, ahora funciona de maravilla, tengo aun ultimo problema, y es el siguiente. Tengo la BD que se llama RE2009M2.mdb, el cual tiene diversar tablas que no se encuentran relacionadas entre si, lo que necesito es lo siguiente yo cada mes tengo que actualizar los datos que se van guardando en la tabla. Por ejemplo, en el primer mes de enero no tengo problemas porque siempre importa los datos desde la fila 2, en el caso del segundo Feberero, cuando importo datos por ejemplo desde el 1 de febrero hasta el 10 de febrero de ahí deseo actualizar, como hago para que me importe los datos desde la fila donde se importo el dia1 de febero.
Public Sub Importar_Enero()
Dim Fila&, filainicio&, ultimafila$, columnacampo As Byte
Dim Query As String
Dim row As Double
Dim rstdata() As Variant
Set cn = New ADODB.Connection
With cn
.provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Data Source=C:\BD_Produccion\RE2009M2.mdb"
.Open
End With
Set rst = New ADODB.Recordset
Query = "Select FechaRemito,CodAsociado,Cliente,NOMAR1,NOMAR2,NOMAR3,NOMCE1,NOMCE2,NOMAG1,NOMAD1,NOMAD2,RAR1,RAR2,RAR3,RCE1,RCE2,RAG1,RAD1,RAD2,M3Real,Anulado from RE1"
On Local Error GoTo Salida
With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Query, cn, , , adCmdText
End With
rstdata = rst.GetRows
row = ActiveSheet.Range("A65536").End(xlUp).row
filainicio& = 2 'Importa datos desde la fila 2
For Fila& = 1 To UBound(rstdata, 2) + 1
For columnacampo = 1 To 21
If Not IsNull(rstdata(columnacampo - 1, Fila& - 1)) Then
Cells(filainicio&, columnacampo) = rstdata(columnacampo - 1, Fila& - 1)
End If
Next columnacampo
Cells(filainicio&, 1).Offset(1, 0).Select
filainicio& = filainicio& + 1
Next Fila&
Call Calc_Mes
rst.Close
cn.Close
Set rst = Nothing
Set cn = Nothing
End
Salida:
MsgBox " No se encuentra la tabla especificada", vbCritical, "ERROR"
End Sub
Mes de febero:
Public Sub Importar_Febrero()
Dim Fila&, filainicio&, ultimafila$, columnacampo As Byte
Dim Query As String
Dim row As Double
Dim rstdata() As Variant
Set cn = New ADODB.Connection
With cn
.provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Data Source=C:\BD_Produccion\RE2009M2.mdb"
.Open
End With
Set rst = New ADODB.Recordset
Query = "Select FechaRemito,CodAsociado,Cliente,NOMAR1,NOMAR2,NOMAR3,NOMCE1,NOMCE2,NOMAG1,NOMAD1,NOMAD2,RAR1,RAR2,RAR3,RCE1,RCE2,RAG1,RAD1,RAD2,M3Real,Anulado from RE2"
On Local Error GoTo Salida
With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Query, cn, , , adCmdText
End With
rstdata = rst.GetRows
row = ActiveSheet.Range("A65536").End(xlUp).row 'tomo el valor de la ultima fila
If Cells(row, 22) = 1 Then ' comparo si la penultima fila el mes es 1
filainicio& = row + 1
For Fila& = 1 To UBound(rstdata, 2) + 1
For columnacampo = 1 To 21
If Not IsNull(rstdata(columnacampo - 1, Fila& - 1)) Then
Cells(filainicio&, columnacampo) = rstdata(columnacampo - 1, Fila& - 1)
End If
Next columnacampo
Cells(filainicio&, 1).Offset(1, 0).Select
filainicio& = filainicio& + 1
Next Fila&
Call Calc_Mes
rst.Close
cn.Close
End If
Set rst = Nothing
Set cn = Nothing
End
Salida:
MsgBox " No se encuentra la tabla especificada", vbCritical, "ERROR"
End Sub
Hasta ahi no hay problema, pero cuando kiero actualizar los datos, me va a coger nuevamente desde la ultima fila, tengo idea , creo que debo buscar siempre el primer dia del primer mes, de ahi importar la data, pero imaginate que si el dia primero de ese mes no se ha almacenado datos en la base datos, surge el problema, espero sinceramente de corazon que me puedas ayudar a resolver esta incognita, una consulta, en el archivo que me has enviado he visto cuando abres la cadena de conexion habre un archivo con la extension .udl, me gustaria saber que tipo de archivo tiene este formato como se crea?
Public Sub Importar_Enero()
Dim Fila&, filainicio&, ultimafila$, columnacampo As Byte
Dim Query As String
Dim row As Double
Dim rstdata() As Variant
Set cn = New ADODB.Connection
With cn
.provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Data Source=C:\BD_Produccion\RE2009M2.mdb"
.Open
End With
Set rst = New ADODB.Recordset
Query = "Select FechaRemito,CodAsociado,Cliente,NOMAR1,NOMAR2,NOMAR3,NOMCE1,NOMCE2,NOMAG1,NOMAD1,NOMAD2,RAR1,RAR2,RAR3,RCE1,RCE2,RAG1,RAD1,RAD2,M3Real,Anulado from RE1"
On Local Error GoTo Salida
With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Query, cn, , , adCmdText
End With
rstdata = rst.GetRows
row = ActiveSheet.Range("A65536").End(xlUp).row
filainicio& = 2 'Importa datos desde la fila 2
For Fila& = 1 To UBound(rstdata, 2) + 1
For columnacampo = 1 To 21
If Not IsNull(rstdata(columnacampo - 1, Fila& - 1)) Then
Cells(filainicio&, columnacampo) = rstdata(columnacampo - 1, Fila& - 1)
End If
Next columnacampo
Cells(filainicio&, 1).Offset(1, 0).Select
filainicio& = filainicio& + 1
Next Fila&
Call Calc_Mes
rst.Close
cn.Close
Set rst = Nothing
Set cn = Nothing
End
Salida:
MsgBox " No se encuentra la tabla especificada", vbCritical, "ERROR"
End Sub
Mes de febero:
Public Sub Importar_Febrero()
Dim Fila&, filainicio&, ultimafila$, columnacampo As Byte
Dim Query As String
Dim row As Double
Dim rstdata() As Variant
Set cn = New ADODB.Connection
With cn
.provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Data Source=C:\BD_Produccion\RE2009M2.mdb"
.Open
End With
Set rst = New ADODB.Recordset
Query = "Select FechaRemito,CodAsociado,Cliente,NOMAR1,NOMAR2,NOMAR3,NOMCE1,NOMCE2,NOMAG1,NOMAD1,NOMAD2,RAR1,RAR2,RAR3,RCE1,RCE2,RAG1,RAD1,RAD2,M3Real,Anulado from RE2"
On Local Error GoTo Salida
With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Query, cn, , , adCmdText
End With
rstdata = rst.GetRows
row = ActiveSheet.Range("A65536").End(xlUp).row 'tomo el valor de la ultima fila
If Cells(row, 22) = 1 Then ' comparo si la penultima fila el mes es 1
filainicio& = row + 1
For Fila& = 1 To UBound(rstdata, 2) + 1
For columnacampo = 1 To 21
If Not IsNull(rstdata(columnacampo - 1, Fila& - 1)) Then
Cells(filainicio&, columnacampo) = rstdata(columnacampo - 1, Fila& - 1)
End If
Next columnacampo
Cells(filainicio&, 1).Offset(1, 0).Select
filainicio& = filainicio& + 1
Next Fila&
Call Calc_Mes
rst.Close
cn.Close
End If
Set rst = Nothing
Set cn = Nothing
End
Salida:
MsgBox " No se encuentra la tabla especificada", vbCritical, "ERROR"
End Sub
Hasta ahi no hay problema, pero cuando kiero actualizar los datos, me va a coger nuevamente desde la ultima fila, tengo idea , creo que debo buscar siempre el primer dia del primer mes, de ahi importar la data, pero imaginate que si el dia primero de ese mes no se ha almacenado datos en la base datos, surge el problema, espero sinceramente de corazon que me puedas ayudar a resolver esta incognita, una consulta, en el archivo que me has enviado he visto cuando abres la cadena de conexion habre un archivo con la extension .udl, me gustaria saber que tipo de archivo tiene este formato como se crea?
Hola, con respecto a formato archivo .UDL, sirve para crear acceso a base datos, ya se como crearlo, ya se para que sirve, gracias sinceremente desconocía este tipo de formato de archivo. Espero que me puedas ayudar con la pregunta que te hice. Gracias por tu amabilidad y tiempo.
Me alegro de que te haya sido útil la información.
Los archivos UDL son muy cómodos para este tipo de temas, ademas si lo abres con el notepad tienes la cadena de conexión para pegarla directamente :-).
Para lo que comentas hay varias opciones.
- La más simple probablemente sea preparar una vista de tipo UNION que es trivial y con eso vas acumulando los datos de los distintos meses en una misa query y luego la importar desechando lo anterior. ( En access creo que las llaman agregadas). Si has cambiado la información en la excel esta no te vale.
- La otra opción es comprobar donde tienes la ultima linea escrita, bien en la macro ( que antes de escribir mire es hay algo )bien poniendo ' a pelo ' en alguna celda donde quieres que empiece.
Ya la opción la que te sea más conveniente.
Los archivos UDL son muy cómodos para este tipo de temas, ademas si lo abres con el notepad tienes la cadena de conexión para pegarla directamente :-).
Para lo que comentas hay varias opciones.
- La más simple probablemente sea preparar una vista de tipo UNION que es trivial y con eso vas acumulando los datos de los distintos meses en una misa query y luego la importar desechando lo anterior. ( En access creo que las llaman agregadas). Si has cambiado la información en la excel esta no te vale.
- La otra opción es comprobar donde tienes la ultima linea escrita, bien en la macro ( que antes de escribir mire es hay algo )bien poniendo ' a pelo ' en alguna celda donde quieres que empiece.
Ya la opción la que te sea más conveniente.
Buenos días, ante todo gracias por la ambilidad de ayudarme, la segunda opción que planteas, es la más factible, había pensado en eso, pero he tratado de hacer el código pero no obtenido resultados, no se si me puedas ayudar con el código, el detalle es como decirle a la macro empieza desde tal fecha del mes, si en código pongo condicional que empiece importar datos desde el 01/02/2009, para el mes de febrero siempre me coja el primer día, puede ser que ese día no hayan registros, ahí donde tengo problema como decirle cogeme desde tal celda, para empezar a importar mi datos, espero que me puedas ayudar, gracias ante todo.
El código es simple.
Haz un bucle en la columna 'a' o donde tengas la fecha infinito o le pones 100000 de tope. Para recorrer las filas
Coges el valor de la celda de la columna 1 para cada fila y guardas el valor ( la fecha)
Cuando haya uno vacío paras y ya tienes la ultima fecha y la ultima fila a partir de la cual debes importar.
Asumo que la información está ordenada y que no tiene huecos.
Luego haces la misma fecha pero pones al final
where fecha > 'la ultima fecha que tienes'
Con eso debería funcionar.
Si haces el código en procedimientos parecido a la plantilla que te pasé te será más fácil ir modificándolo.
Haz un bucle en la columna 'a' o donde tengas la fecha infinito o le pones 100000 de tope. Para recorrer las filas
Coges el valor de la celda de la columna 1 para cada fila y guardas el valor ( la fecha)
Cuando haya uno vacío paras y ya tienes la ultima fecha y la ultima fila a partir de la cual debes importar.
Asumo que la información está ordenada y que no tiene huecos.
Luego haces la misma fecha pero pones al final
where fecha > 'la ultima fecha que tienes'
Con eso debería funcionar.
Si haces el código en procedimientos parecido a la plantilla que te pasé te será más fácil ir modificándolo.
Buenos días, estimado amigo, una consulta, mira aun tengo problemas en mi validación, yo importo los datos, tengo una procedimiento que me llama a otros procedimientos, cuando ejecuto mi macro, por ejemplo:
Private Sub CommandButton1_Click()
Call ImportacionData()
end sub
Public sub ImportacionData()
call importacion_enero
call importacion_febereo
.......
call call importacion_diciembre
end sub
Me importa la datos del primer mes, pero ya no del siguiente mes, es por el mismo hecho que el control de error que estoy usando tiene el termino end, el cual termina finaliza una llamada de un procedimiento, como puedo solucionarlo, otro lado, estoy haciendo un bucle para que me compare fecha, mayor y menor de un determinado mes para poder coger el menor fecha, desde ahí volver actualizar la data importada, espero que me puedas ayudar ya que necesito solucionar estos problemas con urgencia, saludos
Private Sub CommandButton1_Click()
Call ImportacionData()
end sub
Public sub ImportacionData()
call importacion_enero
call importacion_febereo
.......
call call importacion_diciembre
end sub
Me importa la datos del primer mes, pero ya no del siguiente mes, es por el mismo hecho que el control de error que estoy usando tiene el termino end, el cual termina finaliza una llamada de un procedimiento, como puedo solucionarlo, otro lado, estoy haciendo un bucle para que me compare fecha, mayor y menor de un determinado mes para poder coger el menor fecha, desde ahí volver actualizar la data importada, espero que me puedas ayudar ya que necesito solucionar estos problemas con urgencia, saludos
Buenos días, ante todo darte las gracias por el material que me proporcionastes, con respecto al problema que tuve, pude solucionarlo de la siguiente manera, dejo el código, en caso alguien pueda necesitarlo, y pueda adaptarlo a sus necesidades:
Procedimiento lmporto datos del mes de enero, que es una tabla con registros, de producción del mes de enero
Public Sub Importar_Enero()
Dim Fila&, filainicio&, ultimafila$, columnacampo As Byte
Dim Query As String
Dim row As Double
Dim rstdata() As Variant
On Error GoTo Error
Set cn = New ADODB.Connection
With cn
.provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Data Source=C:\BD_Produccion\RE2009M2.mdb"
.Open
End With
Set rst = New ADODB.Recordset
Query = "Select FechaRemito,CodAsociado,Cliente,NOMAR1,NOMAR2,NOMAR3,NOMCE1,NOMCE2,NOMAG1,NOMAD1,NOMAD2,RAR1,RAR2,RAR3,RCE1,RCE2,RAG1,RAD1,RAD2,M3Real,Anulado from RE1"
With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Query, cn, , , adCmdText
End With
rstdata = rst.GetRows
row = ActiveSheet.Range("A65536").End(xlUp).row
filainicio& = 2
For Fila& = 1 To UBound(rstdata, 2) + 1
For columnacampo = 1 To 21
If Not IsNull(rstdata(columnacampo - 1, Fila& - 1)) Then
Cells(filainicio&, columnacampo) = rstdata(columnacampo - 1, Fila& - 1)
End If
Next columnacampo
Cells(filainicio&, 1).Offset(1, 0).Select
filainicio& = filainicio& + 1
Next Fila&
Call Calc_Mes
Call OrdenarAsc
rst.Close
cn.Close
Set rst = Nothing
Set cn = Nothing
Exit Sub
Error:
MsgBox ("No hay registros"), vbCritical, "Error"
End Sub
Importa los datos y pueda actualizar los datos del mes de febrero
Public Sub Importar_Febrero()
Dim Fila&, filainicio&, ultimafila$, columnacampo As Byte
Dim Query As String
Dim row As Double
Dim fecha, fechaI, min As Date
Dim rstdata() As Variant
min = 99999
On Error GoTo Error 'Control de errores
Set cn = New ADODB.Connection
With cn
.provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Data Source=C:\BD_Produccion\RE2009M2.mdb"
.Open
End With
Set rst = New ADODB.Recordset
Query = "Select FechaRemito,CodAsociado,Cliente,NOMAR1,NOMAR2,NOMAR3,NOMCE1,NOMCE2,NOMAG1,NOMAD1,NOMAD2,RAR1,RAR2,RAR3,RCE1,RCE2,RAG1,RAD1,RAD2,M3Real,Anulado from RE2"
With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Query, cn, , , adCmdText
End With
rstdata = rst.GetRows
row = ActiveSheet.Range("A65536").End(xlUp).row
fecha = Cells(row, 1) ' capturo la ultima fecha de la celda final
For j = 1 To row ' recorro el total de filas de la columna A
i = j + 1
fechaI = Cells(i, 1) 'almaceno la fecha de la celda 2 de la columna A
If fechaI <= "28 / 2 / 2009" And Cells(i, 22) = 2 Then ' comparo si la fecha que he capturado es menor igual al ultimo dia del mes de febrero y si la celda 22 de la fila 2 contiene el numero 2 ( Extai el mes del parametro fecha)
If fechaI < min Then ' comparo si la fecha es menor que min donde min puse valor alto para poder capturar como valor min la fecha de la celda 2 columna A
min = fechaI ' almaceno la fecha en min
Cells(i, 1). Select ' activo la celda 2 de la columna A, para poder sacar el numero de filas
row = ActiveCell.row ' almaceno la posicion de la fila en este caso es 2
End If
End If
Next
If Cells(row, 22) = 1 Then ' con esto verifico que si el mes es 1, si es enero, que me importe los datos desde la celda final +1 porque si importo los datos desde row, me importara los datos desde la ultima fila que contiene datos el mes de enero.
filainicio& = row + 1 ' por eso incremento en 1 para que me importe desde la celda vacia
ElseIf Cells(row, 22) = 2 Then ' en este caso verifico que si existen datos ya importados desde el mes de enero, que me importe los datos desde la fecha menor, siendo rows quien me guarda su posicion de la celda menor , comienzo actualizar la data de la tabla.
filainicio& = row ' empieza a importarme
End If
For Fila& = 1 To UBound(rstdata, 2) + 1
For columnacampo = 1 To 21
If Not IsNull(rstdata(columnacampo - 1, Fila& - 1)) Then
Cells(filainicio&, columnacampo) = rstdata(columnacampo - 1, Fila& - 1)
End If
Next columnacampo
Cells(filainicio&, 1).Offset(1, 0).Select
filainicio& = filainicio& + 1
Next Fila&
Call Calc_Mes
Call OrdenarAsc
rst.Close
cn.Close
Set rst = Nothing
Set cn = Nothing
Exit Sub 'Si encuentra un error, cuando la tabla no exista en la base datos, mostrar mensaje de error, finalizando el procedimiento y continua con los demas procedimientos, no usar END porque finaliza y termina el procedimiento , ya no llama los demas procedimiento.
Error:
MsgBox ("Tabla:Mes Febrero no contiene datos"), vbInformation, "INFO"
End Sub
Lo que hice, fue hacer un recorrido de la cela que contiene las fechas, cogí el parámetro de la fecha menor, correspondiente al mes de febrero, así puedo saber desde que celda empezó a importar los datos, de esta manera solucione el problema, con respecto al mensaje de error, el problema es que le había puesto END, en vez de Exit sub, con end estoy diciendo que si encuenta un error, termine de ejecutarse el procedimiento impidiéndome llamar a otros procedimientos, en el caso exist sub solo termina elproceso que estoy ejecutando y continua con los siguiente procedimiento, gracias por la ayuda brinda, saludos, para solucionar el problema recordé mucho un algoritmo calcular el numero mayor y menor, en este caso necesitaba la fecha menor.
Procedimiento lmporto datos del mes de enero, que es una tabla con registros, de producción del mes de enero
Public Sub Importar_Enero()
Dim Fila&, filainicio&, ultimafila$, columnacampo As Byte
Dim Query As String
Dim row As Double
Dim rstdata() As Variant
On Error GoTo Error
Set cn = New ADODB.Connection
With cn
.provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Data Source=C:\BD_Produccion\RE2009M2.mdb"
.Open
End With
Set rst = New ADODB.Recordset
Query = "Select FechaRemito,CodAsociado,Cliente,NOMAR1,NOMAR2,NOMAR3,NOMCE1,NOMCE2,NOMAG1,NOMAD1,NOMAD2,RAR1,RAR2,RAR3,RCE1,RCE2,RAG1,RAD1,RAD2,M3Real,Anulado from RE1"
With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Query, cn, , , adCmdText
End With
rstdata = rst.GetRows
row = ActiveSheet.Range("A65536").End(xlUp).row
filainicio& = 2
For Fila& = 1 To UBound(rstdata, 2) + 1
For columnacampo = 1 To 21
If Not IsNull(rstdata(columnacampo - 1, Fila& - 1)) Then
Cells(filainicio&, columnacampo) = rstdata(columnacampo - 1, Fila& - 1)
End If
Next columnacampo
Cells(filainicio&, 1).Offset(1, 0).Select
filainicio& = filainicio& + 1
Next Fila&
Call Calc_Mes
Call OrdenarAsc
rst.Close
cn.Close
Set rst = Nothing
Set cn = Nothing
Exit Sub
Error:
MsgBox ("No hay registros"), vbCritical, "Error"
End Sub
Importa los datos y pueda actualizar los datos del mes de febrero
Public Sub Importar_Febrero()
Dim Fila&, filainicio&, ultimafila$, columnacampo As Byte
Dim Query As String
Dim row As Double
Dim fecha, fechaI, min As Date
Dim rstdata() As Variant
min = 99999
On Error GoTo Error 'Control de errores
Set cn = New ADODB.Connection
With cn
.provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Data Source=C:\BD_Produccion\RE2009M2.mdb"
.Open
End With
Set rst = New ADODB.Recordset
Query = "Select FechaRemito,CodAsociado,Cliente,NOMAR1,NOMAR2,NOMAR3,NOMCE1,NOMCE2,NOMAG1,NOMAD1,NOMAD2,RAR1,RAR2,RAR3,RCE1,RCE2,RAG1,RAD1,RAD2,M3Real,Anulado from RE2"
With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Query, cn, , , adCmdText
End With
rstdata = rst.GetRows
row = ActiveSheet.Range("A65536").End(xlUp).row
fecha = Cells(row, 1) ' capturo la ultima fecha de la celda final
For j = 1 To row ' recorro el total de filas de la columna A
i = j + 1
fechaI = Cells(i, 1) 'almaceno la fecha de la celda 2 de la columna A
If fechaI <= "28 / 2 / 2009" And Cells(i, 22) = 2 Then ' comparo si la fecha que he capturado es menor igual al ultimo dia del mes de febrero y si la celda 22 de la fila 2 contiene el numero 2 ( Extai el mes del parametro fecha)
If fechaI < min Then ' comparo si la fecha es menor que min donde min puse valor alto para poder capturar como valor min la fecha de la celda 2 columna A
min = fechaI ' almaceno la fecha en min
Cells(i, 1). Select ' activo la celda 2 de la columna A, para poder sacar el numero de filas
row = ActiveCell.row ' almaceno la posicion de la fila en este caso es 2
End If
End If
Next
If Cells(row, 22) = 1 Then ' con esto verifico que si el mes es 1, si es enero, que me importe los datos desde la celda final +1 porque si importo los datos desde row, me importara los datos desde la ultima fila que contiene datos el mes de enero.
filainicio& = row + 1 ' por eso incremento en 1 para que me importe desde la celda vacia
ElseIf Cells(row, 22) = 2 Then ' en este caso verifico que si existen datos ya importados desde el mes de enero, que me importe los datos desde la fecha menor, siendo rows quien me guarda su posicion de la celda menor , comienzo actualizar la data de la tabla.
filainicio& = row ' empieza a importarme
End If
For Fila& = 1 To UBound(rstdata, 2) + 1
For columnacampo = 1 To 21
If Not IsNull(rstdata(columnacampo - 1, Fila& - 1)) Then
Cells(filainicio&, columnacampo) = rstdata(columnacampo - 1, Fila& - 1)
End If
Next columnacampo
Cells(filainicio&, 1).Offset(1, 0).Select
filainicio& = filainicio& + 1
Next Fila&
Call Calc_Mes
Call OrdenarAsc
rst.Close
cn.Close
Set rst = Nothing
Set cn = Nothing
Exit Sub 'Si encuentra un error, cuando la tabla no exista en la base datos, mostrar mensaje de error, finalizando el procedimiento y continua con los demas procedimientos, no usar END porque finaliza y termina el procedimiento , ya no llama los demas procedimiento.
Error:
MsgBox ("Tabla:Mes Febrero no contiene datos"), vbInformation, "INFO"
End Sub
Lo que hice, fue hacer un recorrido de la cela que contiene las fechas, cogí el parámetro de la fecha menor, correspondiente al mes de febrero, así puedo saber desde que celda empezó a importar los datos, de esta manera solucione el problema, con respecto al mensaje de error, el problema es que le había puesto END, en vez de Exit sub, con end estoy diciendo que si encuenta un error, termine de ejecutarse el procedimiento impidiéndome llamar a otros procedimientos, en el caso exist sub solo termina elproceso que estoy ejecutando y continua con los siguiente procedimiento, gracias por la ayuda brinda, saludos, para solucionar el problema recordé mucho un algoritmo calcular el numero mayor y menor, en este caso necesitaba la fecha menor.
- Compartir respuesta
- Anónimo
ahora mismo