2 nov 2011

Extraer SQL en Excel (II)

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

**********************************************************

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
**********************************************************

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

Set tb = CurrentDb.TableDefs("")
tbExists = Err.Number = 0
If tbExists Then
     MsgBox "Existe"
Else
     MsgBox "No existe"
End If
**********************************************************