Esta "extracción de datos" se realizará en un Excel nuevo a partir del resultado de una consulta existente que deberá indicarse en el código que se muestra a continuación. En él se indica el número de la celda en la que se debe comenzar a introducir los valores.
El siguiente código deberá introducirse en el módulo correspondiente (módulos, botón, etc.) y sustituirse los corchetes y su contenido por lo que corresponda.
**********************************************************
'Archivo plantilla, usa SQL, Inserta Datos en hoja y Guarda Fichero con un nombre.
'Declaración de variables
Dim aFullPath As String
Dim appExcel, bkExcel, sh1Excel, rngExcel As Object
Dim cnt As Integer
'Averigua ruta, ejecuta Excel y abre un archivo concreto
aFullPath = CurrentProject.Path & "\RIC"
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True
Set bkExcel = appExcel.Workbooks.Open(aFullPath & "\RIC.xltx")
Set sh1Excel = bkExcelWorksheets(1)
Set rngExcel = sh1Excel.Range("A8:AE10000")
sh1Excel.Cells(8, 5).Value = "Generating data..."
'Usa SQL
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SQL;")
'Inserta Datos en hoja
If (rs.RecordCount > 0) Then
cnt = 1
Call rngExcel.CopyFromRecordset(rs, 9000, 31)
End If
'Guarda Fichero con un nombre
sh1Excel.SaveAs (aFullPath & "\RIC" & Left(Date, 2) & Mid(Date, 4, 2) & Right(Date, 2))
rs.Close
Set rs = Nothing
**********************************************************
Access y VBA
El blog de Access
2 nov 2011
2 ago 2011
Do While / Loop
Este código permite el acceso a una tabla (o consulta de selección) de forma secuencial de modo que pase por todos los registros para la realización de búsquedas, actualizaciones, etc.
El ejemplo siguiente accede a dos tablas en las que, comparando el campo NIF añade la fecha de nacimiento de la persona incluida en las tablas.
**********************************************************
Dim rs1, rs2 As DAO.Recordset
Set rs1 = CurrentDb.OpenRecordset("Personal")
Set rs2 = CurrentDb.OpenRecordset("FelizCumpleannos")
rs1.MoveFirst
Do While Not rs1.EOF()
rs2.MoveFirst
Do While Not rs2.EOF()
If rs1!NIF = rs2!NIF Then
rs2!FNac=rs1!FNac
rs2.MoveLast
End If
rs2.MoveNext
Loop
rs1.MoveNext
Loop
rs1.Close
rs2.Close
**********************************************************
El siguiente ejemplo accede a dos tablas, pero esta vez para incluir un registro nuevo en la segunda tabla por cada registro existente en la primera tabla.
**********************************************************
Dim rs1, rs2 As DAO.Recordset
Set rs1 = CurrentDb.OpenRecordset("Personal")
Set rs2 = CurrentDb.OpenRecordset("FelizNavidad")
rs1.MoveFirst
Do While Not rs1.EOF()
With rs2
.Add
!Nombre=rs1!Nombre
!Apellidos=rs1!Apellidos
!Direccion=rs1!Direccion
!CP=rs1!CP
!Municipio=rs1!Municipio
!Provincia=rs1!Provincia
.Update
End With
rs1.MoveNext
Loop
rs1.Close
rs2.Close
**********************************************************
El ejemplo siguiente accede a dos tablas en las que, comparando el campo NIF añade la fecha de nacimiento de la persona incluida en las tablas.
**********************************************************
Dim rs1, rs2 As DAO.Recordset
Set rs1 = CurrentDb.OpenRecordset("Personal")
Set rs2 = CurrentDb.OpenRecordset("FelizCumpleannos")
rs1.MoveFirst
Do While Not rs1.EOF()
rs2.MoveFirst
Do While Not rs2.EOF()
If rs1!NIF = rs2!NIF Then
rs2!FNac=rs1!FNac
rs2.MoveLast
End If
rs2.MoveNext
Loop
rs1.MoveNext
Loop
rs1.Close
rs2.Close
**********************************************************
El siguiente ejemplo accede a dos tablas, pero esta vez para incluir un registro nuevo en la segunda tabla por cada registro existente en la primera tabla.
**********************************************************
Dim rs1, rs2 As DAO.Recordset
Set rs1 = CurrentDb.OpenRecordset("Personal")
Set rs2 = CurrentDb.OpenRecordset("FelizNavidad")
rs1.MoveFirst
Do While Not rs1.EOF()
With rs2
.Add
!Nombre=rs1!Nombre
!Apellidos=rs1!Apellidos
!Direccion=rs1!Direccion
!CP=rs1!CP
!Municipio=rs1!Municipio
!Provincia=rs1!Provincia
.Update
End With
rs1.MoveNext
Loop
rs1.Close
rs2.Close
**********************************************************
Existencia de tablas, consultas, ...
El siguiente código VBA es para realizar la comprobación de existencia de una tabla, consulta o cualquier otro objeto para trabajar con él con posterioridad. Es decir, saber de antemano si existe, por ejemplo, una tabla antes de realizar un acceso a la misma y que se produzca un error en caso de no existir.
Sólo quedaría incluir el nombre de la tabla entre las comillas situadas entre paréntesis.
**********************************************************
Dim tb As DAO.TableDef
On Error Resume Next
Sólo quedaría incluir el nombre de la tabla entre las comillas situadas entre paréntesis.
**********************************************************
Dim tb As DAO.TableDef
On Error Resume Next
Set tb = CurrentDb.TableDefs("")
tbExists = Err.Number = 0
If tbExists Then
MsgBox "Existe"
Else
MsgBox "No existe"
End If
**********************************************************
**********************************************************
Suscribirse a:
Entradas (Atom)