.
  • Access Vs MySQL
  • Access Vs PowerPoint
  • Sintaxis para subformularios
  • Caracteres gráficos en listas, combos, ....
  • Barras de menús. Automatizar creación. -hasta 2003-
  • Escanear documentos (tiff, pdf)
  • Imprimir archivos tif
  • Simular RemoveItem en listas de Access 2000
  • Unir archivos tif
  • Cuadro de lista a modo de treeview
  • Extraer texto de un PDF
  • Formulario como sustituto de InputBox
  • Comprobar cita
  • Ribbon para torpes
  • Ribbon: posicionar Tab
  • Tratar XML con DOM
  • Escribir XML con DOM
  • Limpieza cabeceras XML
  • FTP. Protocolo SFTP, uso de PuTTY
  • SendKeys con Scripting
  • CallByName ejecutar sub / function por el nombre
  • FileSystemObject

  • RUTINAS
  • IF múltiple simplificado
  • ¿ Existe una tabla ?
  • Crear filtros con Listas con selección múltiple
  • Fechas en VBA y SQL
  • Usar propiedades como constantes persistentes
  • Generar numeros únicos en sustitución de los autonuméricos
  • Averiguar el autonumérico asignado

  • SQL
  • Encadenar valores de una tabla
  • Numerar una consulta
  • Numerar una consulta por grupos
  • Crear un campo con suma continua
  • Funciones personales en SQL (I)
  • Funciones personales en SQL (II). Calcular diferencias
  • Funciones personales en SQL (III). Desglose moneda
  • Tabla Numeros
  • TNumeros (I). Datos en un periodo anual
  • TNumeros (II). Datos en un periodo bienal
  • TNumeros (III). Resumen ingresos / gastos multi anual

  • OTROS
  • Se ha producido el error ‘3188’ en tiempo de ejecución
  • Adjuntar Tablas (sólo las visibles)
  • Mensaje error márgenes en informes

  • Sintaxis para subformularios

    ¡La Biblia!. Siempre que tengas un problema de como nombrar un control, una propiedad, un método, ... tenlo a mano

    Bajar documento



    Caracteres gráficos en listas, combos, ...

    Para esas ocasiones en las que queremos incluir un caracter gráfico en una lista, combo, etc ... la manera de realizarlo es muy simple, basta con usar la función ChrW$.
    Por ejemplo, vamos a modificar una lista de forma que saque el caracter check si un campo es verdadero y nulo si es falso.
    En el RowSource de la lista sustituimos el campo Sel (que es un campo si/no) por IIF(Sel = True, ChrW$(10004), '').

    Siendo el resultado ...

    ... simulando un treeview ...

    Para saber los códigos de estos caracteres podemos acudir al mapa de caracteres que tenemos en:
          Windows-> Accesorios -> Herramientas del sistema

    o acudir a una página que los contenga ... WIKIPEDIA. Lista de Carateres Unicode

    IMPORTANTE: Los códigos que nos facilita tanto esta página como el mapa de caracteres son hexadecimales, hay que convertirlo a decimales antes de ponerlos en la función ChrW$.

    Para almas inquietas ... el aspa de borrado se puede obtener utilizando el ChrW$(10007) o el ChrW$(10008). A me me gusta el 7.




    Barras de menús. Automatizar creación. -hasta 2003-

    En estos dias, hemos estado todos muy liados con el tema de los menús, a partir de intentar acoplar las barras de menús en su creación se me ocurrió automatizar la creación de los mismos basandonos en una tabla.
    La idea es tener esta tabla creada, con nuestros árboles de menús, el general, el de 'favoritos' -esas 5/6 funciones que son el 90 % del trabajo de un usuario-, los contextuales y los menús propios de cada formulario...
    En el arranque de la aplicación, capturamos usuario y contraseña, con eso averiguamos su 'perfil' de usuario y creamos los menus en base a este perfil. En la tabla podemos definir si tiene permiso de entrada a las opciones, con lo que al crear el menu, aquellas opciones que no le hallamos dado permiso, las tendrá desactivadas.... Con esto conseguimos hacer menús personalizados para cada usuario....

    Es la primera versión.... manifiestamente mejorable.....

    Tengo en preparación lo mismo con el Ribbon, espero tenerlo pronto a punto

    Bajar ejemplo



    Escanear documentos (tiff, pdf)

    A partir de los datos obtenidos en el foro del buho, más concretamente de la expuesto por Monyi en este hilo http://www.mvp-access.com/foro/forum_posts.asp?TID=24203, hice una primera versión del proceso que nos permitiera escanear imágenes desde Access.
    El usuario Joffer proporcionó una importante pista de como manejar más en profundidad las propiedades del escaner en este otro hilo: http://www.mvp-access.com/foro/forum_posts.asp?TID=57766

    He rehecho el ejemplo para que nos dé respuesta a varias cosas:

    1. Conseguir escanear, con/sin la pantalla de WIA. Pasarle las opciones al escáner directamente por programa. Es decir el escaneo transparente.
    2. Permitir guardar los resultados en TIFF o PDF (este último formato es el más aceptado por todos los usuarios).
    3. Ejecutar un proceso en el formulario llamante después de escanear el documento. Para ello en los argumentos de llamada le pasaríamos el nombre del formulario que llama, y este tendría que tener una funcion con el nombre EscanearProceso

    Para pasar el documento a PDF lo que hacemos es 'imprimir' las imágenes en un informe de access que:
    • si es 2007 imprimimos directamente a PDF (es como está implementado el ejemplo)
    • si es anterior usamos la rutina de Lebans para pasar un informe a PDF

    He puesto un botón: "Propiedades escáner" - que nos permitirá ver las propiedades soportadas por el mismo.

    Como siempre esto es un código abierto, cada uno que se lo personalice según le convenga....

    Bajar ejemplo



    Imprimir archivos tif

    Necesitaba poder imprimir directamente ficheros tipo tif (base de documentos escaneados) directamente desde access y no era tan simple como parecía, ya que investigando como lo hace el windows su método no me sirve, ya que lanza el asistente de impresión de fotos .... y tenía que ser automático....

    Una primera manera, que me puso sobre la pista Emilio, es con el FotoEditor que viene con el office:

    Private Sub ImprimirArchivo()
        Dim RutaDoc As String, Retval
        RutaDoc = Chr(34) & "C:\Mis documentos\AltaSS.tif" & Chr(34)
        Retval = Shell("C:\Archivos de programa\Archivos comunes\Microsoft Shared\PhotoEd\PHOTOED.EXE /p " & RutaDoc, 0)
    End Sub

    Pero no me gusta por dos razones, una: no todo el mundo tiene el foto-editor instalado, dos: es bastante lento. Quería hacerlo con el visor de documentos y fax de windows, pero como Dios manda, no está documentado (o la documentación está muy escondida para los simples mortales), .... además tiene dos complicaciones añadidas: a este método no le vale con la orden print y sólo coge la impresora por defecto, tienes que decirle tú que impresora quieres (y esto es lo que más costó de adivinar). Al final queda:

    Private Sub ImprimirArchivo()
        Dim RutaDoc As String, Printer As String, Retval
        RutaDoc = Chr(34) & "C:\Mis documentos\AltaSS.tif" & Chr(34)
        Printer = Chr(34) & "HP Deskjet series F300" & Chr(34)
        Retval = Shell(rundll32.exe C:\WINDOWS\System32\shimgvw.dll,ImageView_PrintTo /pt " & RutaDoc & " " & Printer, 0)
    End Sub

    Lo de encerrar el nombre de documento e impresora entre los caracteres chr(34) es para que coja bien los blancos de la ruta y del nombre de la impresora, este era otro charco más en el camino, que me solucionó Prga.

    En el caso de querer coger la impresora predeterminada del sistema de modo automático, podemos utilizar la función GetDefaultPrinter que viene en la página de Happy

    P.D. - Ni que decir tiene que con este método se puede imprimir automáticamente cualquier archivo de tipo .jpg .bmp, etc... que admita el visor de windows




    Simular RemoveItem en listas de Access 2000

    En Access 2000 a veces necesitamos eliminar un elemento de una lista, como no existe el 'RemoveItem', lo podemos simular con la función split....

    Private Sub RemoveItem2000()
    Dim gl_var As Variant, gl_integer As Integer, gl_string As String
        '* descomponemos la matriz
        gl_var = Split(Me.ListaAdjuntos.RowSource, ";")
        '* tratamiento, primero pasamos los anteriores al seleccionado y despues los posteriores
        gl_string = ""
        For gl_integer = 0 To Me.ListaAdjuntos.ListIndex - 1
           gl_string = gl_string gl_var(gl_integer) ";"
        Next gl_integer
        For gl_integer = Me.ListaAdjuntos.ListIndex + 1 To Me.ListaAdjuntos.ListCount - 1
           gl_string = gl_string gl_var(gl_integer) ";"
        Next gl_integer
        '* pasamos el valor obtenido a la lista
        Me.ListaAdjuntos.RowSource = gl_string
    End Sub

    Nota: esta hecho para una lista de una sola columna.....




    Unir archivos tif

    Al querer enviar varios archivos tipo tif (que es como se suelen guardar las B.D. documentales) por fax se nos plantea el hecho de que hay que juntar esos archivos en uno solo, para efectuar una sola llamada.

    He visto programas que lo hacen, el propio Document Imaging de Microsoft lo hace, pero requiere el concurso del usuario.

    Mirando como hacerlo de modo automatizado, he aprovechado las funcionalidades que nos proporciona el WIA, que yo utilizo para escanear documentos desde access.

    Os creáis el siguiente procedimiento

    Private Sub RT_UnirArchivosTif(ArchivoDestino As String, ListaArchivos As String)
    'la lista de archivos se pasan separados por ";"
    Dim Img 'As ImageFile
    Dim Page2 'As ImageFile
    Dim IP 'As ImageProcess
    Dim MatrizArchivos As Variant, NumeroArchivo As Integer, NumeroPagina As Long
    '* nos aseguramos que el archivo de salida no exista
        On Error Resume Next
        Kill ArchivoDestino
        On Error GoTo 0
    '* obtenemos la matriz de archivos
        MatrizArchivos = Split(ListaArchivos, ";")

    '* cargamos la primera imagen
        Set Img = CreateObject("WIA.ImageFile")
        Img.LoadFile MatrizArchivos(0)

    '* bucle para el resto de imagenes
        For NumeroArchivo = 1 To UBound(MatrizArchivos)
        'creamos una instancia y cargamos la imagen
          Set Page2 = CreateObject("WIA.ImageFile")
          Page2.LoadFile MatrizArchivos(NumeroArchivo)
          'un proceso por cada pagina que tenga el archivo
          For NumeroPagina = 1 To Page2.FrameCount
            Set IP = CreateObject("WIA.ImageProcess")
            Page2.ActiveFrame = NumeroPagina
            IP.Filters.Add IP.FilterInfos("Frame").FilterID
            Set IP.Filters(IP.Filters.Count).Properties("ImageFile") = Page2
            Set Img = IP.Apply(Img)
            Set IP = Nothing
          Next NumeroPagina
          Set Page2 = Nothing
        Next NumeroArchivo

    '* salvamos la imagen a disco y salimos
        Img.SaveFile ArchivoDestino
        Set Img = Nothing

    End Sub

    Para llamarlo

    Call RT_UnirArchivosTif("C:\Mis documentos\salida.tif", "C:\Mis documentos\11.tif;" _
              "C:\Mis documentos\22.tif;" _
              "C:\Mis documentos\33.tif;" _
              "C:\Mis documentos\34.tif;" _
              "C:\Mis documentos\44.tif")

    Puede dar problemas cuando mezclamos distintos tamaños de archivo A4 con Folio, etc....

    El resultado es simple, aunque tiene su miga, .... lo más costoso ha sido encontrar como tratar los archivos que tienen más de una hoja, la manía esta de los extranjeros de escribir de forma que los demás no lo entendamos...

    La dll WIA se puede descargar en:     Microsoft downloads




    Cuadro de lista a modo de treeview

    Para manejo de dos (o más) tablas relacionadas el treeview es un control muy aparente de cara al usuario, pero como access tiende a llevarse mal con los controles externos (cosas de Microsoft), se puede simular desde el propio access con cuadros de lista. De hecho es muy recomendable no utilizar controles externos para evitar sopresas futuras con los que Microsoft anule con los KillBits.

    Si no queremos simular la expansión/colapso de elementos se puede hacer directamente, y si queremos hacerlo necesitaremos una tabla temporal.

    Pensaba explicar más como funciona el asunto, pero lo mejor para aprender es que cada uno destripe el funcionamiento.

    Yo personalmente uso la primera opción, me ahorro la tabla temporal, y aunque es menos vistoso por la ausencia de comprensión/expansión de elementos, tambien me permite el uso de los menús contextuales en las listas para las distintas opciones, cosa que queda muuu aparente y funcional sin necesidad de implementar el botón derecho del ratón, ya que el izquierdo se 'lo come' el funcionamiento de la lista.

    Saludos. Espero que os sirva.

    Bajar ejemplo



    Extraer texto de un PDF

    Cada día mas empresas envían su información en PDF en lugar de simples ficheros de texto plano o 'words'.

    Obtener esta información de una manera automatizada para posteriormente poder tratarla es una necesidad que es cuestión de tiempo que nos surja.

    He partido de la premisa de no utilizar el Acrobat, ya que no podemos 'obligar' a que el usuario lo tenga. Intente hacerlo mediante automatización con el Acrobat Reader, pero este solo permite incrustarlo en un formulario y navegar por él, como un simple visor.

    Al final lo he hecho apoyándome en un programa GNU-GPL, el PdfToText, el que quiera más documentación este es su sitio web: www.foolabs.com/xpdf/download.html.

    El ejemplo está preparado para usarlo como rutinas, el uso es simple, con el botón de selección elegimos el fichero pdf que queramos convertir y el bissho hace el resto solito.


    Por cierto, gracias a Emilio, al que le he fusilado su ShellWSH, para poder ejecutar el programa en modo síncrono (con espera para que termine la ejecución).


    Nota importante: el programa que ejecuta el proceso es el pdftotext.exe, es imprescindible usar el correspondiente a vuestro sistema operativo, ya sea de 32 ó 64 bits. El que esta incluido en el ejemplo es el de 64 bits, en el caso de que tu sistema operativo sea de 32 bits, bastará con renombrar los archivos (incluyo el pdftotext32.exe)

    Bajar ejemplo



    Formulario como sustituto de InputBox

    En nuestras aplicaciones a veces se nos plantea la necesidad de tener que pedir al usuario que seleccione un valor de entre varios y no queremos usar un inputbox porque nos queda 'pobre' o porque son bastantes elementos a seleccionar y preferimos hacerlo con apariencia de una lista.

    Obviamente, si nos creamos un formulario que nos haga eso y lo podamos llamar desde distintos sitios nos habremos ahorrado un montón de trabajo... :-)

    Esta es mi propuesta:

    Bajar ejemplo



    Comprobar citas

    Cuando trabajamos con citas ya sean horarias o fecha completa siempre surge la 'pega' de comprobar de un modo eficiente si el intervalo que necesitamos está libre o está ocupado por otra cita, obviamente la cosa se complica cuando las horas de inicio y/o fin no coinciden, cuando el periodo que queremos está incluido en otro existente o aún peor, cuando el origen es anterior al origen de la cita con la que se solapa, o el fin posterior .... brrr, ¡que lío!

    Pero puesto en modo gráfico la cosa cambia:
    1 - representa la hora de inicio de una cita existente
    2 - representa su hora de fin


    '         ---------------1------------------2----------------------
    'LIBRE       HI---HF
    'OCUPADA              HI---HF
    'OCUPADA                       HI---HF
    'OCUPADA                                 HI---HF
    'LIBRE                                          HI---HF
    '
    'Si Hini < HoraFinal(2) y Hfin > HoraInicial (1) -> está ocupado


    Set Mitabla = CurrentDb.OpenRecordset("SELECT * FROM TCitas WHERE FechaCita = " & RT_FechaSQL(Me.FechaPedida) & _
         " AND ((" & RT_HoraSQL(Me.HoraInicio) & "<= HoraFinal) AND (" & RT_HoraSQL(Me.HoraFinal) & " >= HoraInicio))")
    If Mitabla.RecordCount <> 0 Then
         Mitabla.Close
         MsgBox "Esta cita entra en conflicto con otra", vbCritical, Me.Caption
         Exit Sub
       Else
         Mitabla.AddNew
         .
         .
         Mitabla.Update
         Mitabla.Close
    End If

    Iba a poner la explicación del cómo lo cazamos tan fácilmente, pero mejor es que lo destripéis, de todas formas con el esquema de líneas LIBRE / OCUPADA se ve claramente como va la cosa

    Las rutinas RT_FechaSQL (me pone una fecha en formato americano con sus separadores) y RT_HoraSQL (idem con la hora) las pondré otro día.

    Yo para no liarme, dejo siempre el esquema en el módulo dónde lo programo, ya que cuando vuelvo a ello al cabo de un año, ni me acuerdo del porqué está hecha así la SQL




    Ribbon: posicionar Tab      16-oct-2023

    Resulta que el Ribbon tiene un comportamiento poco amigable con el usuario. Cuando cierras un formulario el cursor se posiciona en la primera pestaña del mismo ignorando la posición actual y es muy molesto.

    Ejemplo: tienes un Ribbon con la pestaña Clientes, la pestaña Proveedores, una pestaña Tablas con 30 opciones ... resulta que buscas cambiar un valor que no sabes en que tabla está y empiezas a pinchar de una en una, pues cada vez que lo haces el Ribbon se posiciona en la pestaña Clientes con lo que tienes que clicar en la de Tablas y acordarte de que habías hecho antes ... Brr.
    Pensaba que habría alguna manera fácil de hacerlo, pero el Ribbon es muuu cortito, así que ha habido que hacerlo a mano.
    Hay una opción ActivateTab que te permite situarte en la pestaña deseada, pero no hay manera de saber cuál es la pestaña actual así que hay que buscarse la vida.

    Como curiosidad la IA sugiere: Ribbon.ActiveTab.Caption, hay que j%derse con las tonterías que sueltan las 'Listillas Artificiales'.

    Mis Ribbons tienen este formato:


    donde Abrir_Menu es una rutina que abre el formulario que le paso como parámetro, en este caso Contabilidad, así que, como sé el nombre del formulario que cierro puedo acceder al ribbon cargado, buscar en el XML del Ribbon su nombre, desde ahí buscando hacia atrás cual es el tab del que depende, averiguar su id y lanzarlo, queda más fácil hacerlo que decirlo:


    Function RT_CerrarFrmPosicionarRibbon(ByVal FrmName As String) 'V0 2023-10-15
         Dim RbText As String
         Dim L1 As Long, X As String
        
         'leemos el XML del Ribbon cargado
         RbText = DLookup("RibbonXml", "UsysRibbons", "RibbonName = " & RT_StringSQL(CurrentDb.Properties("CustomRibbonID")))
         'buscamos literal (nombre frm) enmarcado con 'xxxxx'
         L1 = InStr(1, RbText, "'" & FrmName & "'")
         'si no existe
         If L1 = 0 Then Exit Function
         'buscamos hacia atras el primer <tab id="Tab000001" label="Lo que sea"
         L1 = InStrRev(RbText, "<tab id", L1)
         'cogemos unos cuantos caracteres a partir de aqui + 1, quitando <tab id" nos queda Tab000001" label="Lo que sea"
         X = Mid$(RbText, L1 + 9, 50)
         'buscamos la " y nos quedamos con el id: Tab000001
         L1 = InStr(1, X, """")
         X = Left$(X, L1 - 1)
        
         On Error Resume Next
         DoCmd.Close acForm, FrmName
         MaximizaRibbon
         gobjRibbon.ActivateTab (X)
    End Function


    La rutina hay que llamarla desde el botón de salida del formulario, y como veis primero se cierra el mismo y después se posiciona el Tab:


    Private Sub Cmd_Salir_Click()
         RT_CerrarFrmPosicionarRibbon (Me.Name)
    End Sub


    Nota, se puede usar el Id del botón para realizar la búsqueda, este le podemos conocer y memorizar en el proceso del OnAction si lanzamos la rutina estándard del Ribbon. Cada uno según su entorno:


    Sub OnActionButton(Control As IRibbonControl)
         Debug.Print Control.Id
    End Sub




    Tratar XML con DOM

    Hasta ahora los ficheros xml solo los usaba de salida, tema de recibos principalmente, y solventaba el problema escribiéndolos como si fuera un fichero de texto (me apunto como tema pendiente el escribirlos mediante librerías DOM).

    Ahora he necesitado tratar ficheros DOM bastante complicados para tratar sus datos como entrada y la cosa se ha enredado bastante. El problema fundamental es la falta de información para poder tratar los mismos y como navegar por los nodos de una manera fácil y rápida (léase esto como una petición de ayuda, si alguien sabe dónde carallo hay información de los mismos se lo agradecería, yo –y algún otro compañero más- lo único que hemos encontrado es información muy ‘ligerita’ e insuficiente para poder resolver el tema).

    Don Emiliove me puso en la pista fundamental:
         www.w3schools.com/xpath

    y ya tirando de la manta:
         www.java2s.com/Code/VBA-Excel-Access-Word/XML/DOMDocument.htm
         www.jpsoftwaretech.com/vba/msxml-object-library-routines/

    El ejemplo tiene dos formularios, que tratan los xml de manera distinta.

    El primero se basa en leer el xml y guardar los datos en una tabla en memoria con dos columnas por elemento, la clave y su valor, y su posterior uso. Es decir Access puro y duro. El formulario tiene dos ejemplos:

    1.- Lectura del fichero xml y guardarlo en una tabla auxiliar con dos campos, uno la clave y otro el valor. El tener los datos guardados de una manera legible nos ayudará a realizar el tratamiento del mismo que a veces cuesta de lo enrevesado que es el fichero xml en si mismo, con sus cascadas de claves, unas con valores y otras sin. A veces el xml viene escrito en una sola linea lo que lo hace ilegible. En esta rutina solo guardamos los campos que tienen valor ignorando el resto, que son los mismos que se guardan en la tabla en memoria para su posterior uso.

    2.- Búsqueda de los datos que necesitamos dentro de esa tabla de valores que ya hemos memorizado y mostrarlos en pantalla.


    El segundo formulario trata el fichero xml con el estandard DOM y tiene tres ejemplos:

    1.- Búsqueda de los datos que necesitamos accediendo directamente a los nodos, ya sean datos únicos o datos repetidos a los que hay que acceder con bucles
    2.- Búsqueda de los nodos que tienen un valor específico, p.ej. un código de artículo determinado
    3.- Búsqueda de los nodos que tienen un valor superior a un valor determinado, p.ej. aquellos cuya cantidad sea superior a un valor dado

    Para aprender cómo lo he hecho tendréis que ver las tripas de los procesos. ¡Que lo disfrutéis!.

    Por cierto, hay que tener mucho cuidado (a mi me volvió tarumba hasta que me dí cuenta) con los literales 'de más' que pueden llevar los ficheros xml, ya que hace que las búsquedas DOM no funcionen, en particular esta cabecera que se incluye en los ficheros formato SEPA hace que no funcione, hay que quitar lo marcado:

    Bajar ejemplo



    Escribir un fichero XML con DOM

    Bueno, esta es la segunda parte, escribir un fichero XML usando DOM.

    Había pensado en obtener el fichero SEPA que es el que todo el mundo quiere, pero mejor eso lo dejo como ejercicio a realizar por vosotros, que si no, no tiene gracia ... :-P. Lo que hago es obtener un fichero muy similar al del ejemplo anterior, un supuesto envío de pedidos, apoyado en las tablas que nos brinda Neptuno.mdb.

    La verdad es que es muy facilito, en cuanto le miréis las tripas le cogeréis el truquillo, ¡que ustedes lo disfruten!

    Bajar ejemplo



    Arreglo (limpieza) de cabeceras XML

    Se supone que se creó el estándard XML para evitar estar haciendo el panoli con los ficheros que se envían y reciben, pero no, hay que complicar las cosas, no sea que nos vayamos a aburrir. En principio he detectado dos tipos de 'errores' en la cabecera que provocan que la lectura con DOM no funcione bien.

    Puede ser la inclusión de un literal inesperado o la incorrecta codificación del modificador de la clave:
        xmlns="http://www.w3.org/2001/XMLSchema-instance

    - en vez del correcto:
        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance

    Para evitar este error se puede seguir el método de usar una hoja de estilo, como propone Emiliove en este hilo del foro mvp-access: Hilo Foro mvp-access.com

    O bien, usar un método más simple que nos modifique manualmente la clave afectada (limpiándola)



    El tratamiento del fichero XML cambiaría de esto:

    Private Sub CmdSelCodigoA_Click()
    Dim xNodes As MSXML2.IXMLDOMNodeList
    Dim xNode As IXMLDOMNode
        
         Set xDoc = New MSXML2.DOMDocument60
         xDoc.async = False
         xDoc.Load (CurrentProject.Path & "\prueba.xml")
        
         Set xNodes = xDoc.selectNodes("//NombreNodo")
         For Each xNode In xNodes
             Debug.Print xNode.Text
         Next
         Set xDoc = Nothing
    End Sub



    a esto:

    Private Sub CmdSelCodigoA_Click()
    Dim Xs As String
    Dim xNodes As MSXML2.IXMLDOMNodeList
    Dim xNode As IXMLDOMNode
        
         Set xDoc = New MSXML2.DOMDocument60
         xDoc.async = False
         xDoc.Load (CurrentProject.Path & "\prueba.xml")
        
         Xs = xDoc.XML
         Xs = RT_LimpiarCabXML(Xs, "ServiceRequest")
         xDoc.loadXML Xs
        
         Set xNodes = xDoc.selectNodes("//MobilePhone")
         For Each xNode In xNodes
             Debug.Print xNode.Text
         Next
         Set xDoc = Nothing
    End Sub




    Function RT_LimpiarCabXML(StringXml As String, Clave As String) As String
    Dim i As Integer, j As Integer
         i = InStr(1, StringXml, Clave & " ")
         j = InStr(i, StringXml, ">")
         RT_LimpiarCabXML = Mid$(StringXml, 1, i + Len(Clave)) & Mid$(StringXml, j)
    End Function



    El resultado obtenido es (antes y después):




    Como se ve en el código expuesto, a la rutina de limpieza hay que pasarle el nombre de la clave que queremos limpiar, en este caso ServiceRequest.




    FTP. Protocolo SFTP, uso de PuTTY      14-nov-2017

    Hay servidores que solo admiten protocolo SFTP, para este caso no vale usar las API’s propias de Windows. Una solución es usar PuTTY.

    Para su uso es necesario tener en el ordenador el programa pscp.exe que viene con el paquete de instalación del PuTTY (no es necesario instalárselo, pero si viene bien para tener el fichero de ayuda del mismo). Se puede obtener aquí: Download PuTTY



    Me he creado una rutina para su uso, que tiene los siguientes parámetros:
    - Ruta del programa pscp.exe
    - Usuario de FTP
    - Password
    - Host FTP


    La rutina es:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Private Sub RT_FTP_PuTTY(ByVal PuTTYRuta As String, PuTTYUsuario As String, PuTTYClave As String, PuTTYHost As String, _
                              ByVal RutaFichero As String, Optional ByVal PathRemoto As String = "")
    Dim Comando As String
        
         'Comando = "C:\Ruta\pscp.exe" -sftp -l USUARIO -pw PASWORD FICHERO HOST :REMOTEPATH

         Comando = """" & PuTTYRuta & """" & " -sftp -l " & PuTTYUsuario & " -pw " & PuTTYClave & " " & _
                   RutaFichero & " " & PuTTYHost & ":" & PathRemoto
         Shell Comando, 1

    End Sub



    Y para llamarla:


         RT_FTP_PuTTY "C:\Ruta\pscp.exe", _
                     "UsuarioFTP", _
                     "ClaveFTP", _
                     "ftp.NombreHost.com", _
                     "C:\Temp\prueba.txt"



    Obviamente también se puede usar con protocolos ‘normales’.




    SendKeys con Scripting      31-may-2018

    No se debe usar SendKeys en Access, da bastantes quebraderos de cabeza, pero si no hay más remedio una manera fácil y que nos ahorra muchos problemas es hacerlo usando scripting. La verdad es que está chupao :-)



    Por ejemplo, enviar un F1:


    '---------------------------------------------------------------------------------------------
    ' Recopilado por : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
         Dim ws As Object
         Set ws = CreateObject("WScript.shell")
         ws.SendKeys "{f1}"
         Set ws = Nothing






    CallByName ejecutar sub / function por el nombre      29-oct-2018

    Cuando tenemos la necesidad de pasar directamente un valor a un campo de otro formulario lo podemos hacer (hay varios formatos) así:
         Forms("MiForm").MiCampo = NuevoValor
    o si es un subformulario:
         Forms("MiForm").Sbf1.Form.MiCampo = NuevoValor

    Si necesitamos tener los valores en variables por necesidades del proceso que estamos implementando podemos usar el formato con la colección Controls:
         Form:      Forms(NombreFormulario).Controls(NombreCampo) = NuevoValor
         Subform: Forms(NombreFormulario).Controls(NombreSubformulario).Form.Controls(NombreCampo) = NuevoValor

    Si lo que queremos es ejecutar un procedimiento sub (o function) el formato sería:
         Form:      Forms("MiForm").Procedimiento
         Subform: Forms("MiForm").Sbf1.Form.Procedimiento
    El problema aquí es que sólo podemos parametrizar el nombre del form/subform pero no el procedimiento:
         Form:      Forms(NombreFormulario).Procedimiento
         Subform: Forms(NombreFormulario).Controls(NombreSubformulario).Form.Procedimiento

    Entonces … ¿cómo hacer lo mismo con el procedimiento?

    Afortunadamente Access dispone de la función CallByName que es la que nos sacará del apuro:
         Form:      CallByName Forms(Formulario), Procedimiento, VbMethod
         Subform: CallByName Forms(Formulario).Controls(Subformulario).Form, Procedimiento, VbMethod

    Recomendable echarle un vistazo a la ayuda de la función y recordar que el procedimiento al que estamos haciendo referencia debe estar declarado como Public y el formulario abierto.





    FileSystemObject, ¿un gran desconocido?      5-sep-2021

    Cuanto más tiempo pasa, más utilidades le descubro a FileSystemObject, por ejemplo la que más usamos todos:

    Copiar archivos:


    Function RT_FileSystemCopy(ByVal Origen As String, ByVal Destino As String)
    Dim Fs As Object
     
        Set Fs = CreateObject("Scripting.FileSystemObject")
        Fs.CopyFile Origen, Destino, True
        Set Fs = Nothing
     
    End Function


    Pero además tiene funciones para tratar carpetas, archivos, unidades, etc. Es cuestión de irlas explorando

    La última utilidad que encontré es averiguar el path corto de una ruta (o archivo). Con el tema este de las unidades compartidas (Sharepoint, OneDrive, …) los usuarios se crean rutas cada vez más largas, … para usarlas en programa hay que mapearlas, lo que añade todavía más longitud, ya que la ruta cuelga del usuario:

        C:\Users\Antonio Perez del Pulgar\Empresa\Departamento contabilidad\Presupuestos 2.021\Archivos del año\....

    En cuanto se pasa de los 260 caracteres la cosa deja de funcionar y si hacemos una copia de un archivo casca. Para evitar el error hay que usar los paths cortos, yo utilizaba una rutina de Happy que tiraba de Apis, pero he encontrado (buscando otra cosa, como Dios manda) que con Fs se hace muy fácil y sin Apis.


    Function RT_FileSystemPathCorto(ByVal Path As String) As String
        Dim Fs As Object, Folder As Object
        
        Set Fs = CreateObject("Scripting.FileSystemObject")
        Set Folder = Fs.getfolder(Path)
        RT_FileSystemPathCorto = Folder.ShortPath
        Set Fs = Nothing

    End Function


    Así:
    Debug.Print RT_FileSystemPathCorto("C:\Temp\Dir20180127204300\Este es un nombre de carpeta muy largo y con espacios para que casque\Este es un nombre de carpeta muy largo y con espacios para que casque1\Este es un nombre de carpeta muy largo y con espacios para que casque2")
    te devolverá (en mi caso):
    C:\Temp\DIR201~1\ESTEES~1\ESTEES~1\ESTEES~1

    Este es un buen manual de FileSystemObject (... y de paso VBScript):     AQUÍ









    RUTINAS

    A la hora de programar hay que ser 'vago', hay que teclear lo menos posible, no volver a pensar como averiguar si un año es bisiesto o no, como comprobar un CIF.... y .... ¿cómo se consigue eso?
    ... con las rutinas, esos trocitos de código, hechos, probados y guardados que con simplemente copiarlos a un módulo nos solucione la vida. Yo tengo unas cuantas rutinas, guardadas como archivos txt, clasificadas por uso: fechas, funciones, SQL, formateo variables, cálculo/comprobación NIF/CIF, etc, ...

    Aquí iremos poniendo algunas de ellas...




    IF múltiple simplificado

    Esta surgió como 'necesidad' de simplificar tanto la escritura como la 'lectura' posterior de esos IF encadenados con OR.
    Por ejemplo, queremos que nuestro código haga algo en el caso de que el valor de un campo de una tabla sea: menor que 5, igual a 7, que esté comprendido entre 15 y 20 o sea mayor que 100

    En VBA queda así:

    If Mitabla!Coeficiente < 5 Or Mitabla!Coeficiente = 7 Or (Mitabla!Coeficiente >= 15 AND Mitabla!Coeficiente <=20) _
        Or Mitabla!Coeficiente > 100 Then
        .
        .

    ¿No quedaría mas simple así?

    If RT_IF_OR (Mitabla!Coeficiente, "<5", 7, "15-20", ">100") Then
        .
        .

    Basta con tener esta rutina en un módulo

    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Function RT_IF_OR(Valor As Variant, ParamArray Xcon()) As Boolean
    Dim ValorC As Variant, ValorC1 As Variant, i As Integer

        RT_If_OR = False
        '
        For i = 0 To UBound(Xcon)
           ValorC = Xcon(i): If Len(ValorC) > 1 Then ValorC = Trim$(ValorC)
           ' si es <
           If Left$(ValorC, 1) = "<" Then
              If IsNumeric(Valor) Then ValorC = Val(Mid$(ValorC, 2)) Else ValorC = Mid$(ValorC, 2)
              If Nz(Valor) < ValorC Then RT_If_OR = True: Exit Function

           ' si es >
           ElseIf Left$(ValorC, 1) = ">" Then
              If IsNumeric(Valor) Then ValorC = Val(Mid$(ValorC, 2)) Else ValorC = Mid$(ValorC, 2)
              If Nz(Valor) > ValorC Then RT_If_OR = True: Exit Function

           ' si contiene un - desde/hasta
           ElseIf InStr(1, ValorC, "-") > 0 Then
              If IsNumeric(Valor) Then
                 ValorC1 = Val(Mid$(ValorC, InStr(1, ValorC, "-") + 1)): ValorC = Val(Left$(ValorC, InStr(1, ValorC, "-") - 1))
                Else
                 ValorC1 = Mid$(ValorC, InStr(1, ValorC, "-") + 1): ValorC = Left$(ValorC, InStr(1, ValorC, "-") - 1)
              End If
              If Nz(Valor) >= ValorC And Nz(Valor) <= ValorC1 Then RT_If_OR = True: Exit Function

           ' compara el valor pasado
           Else
              If IsNumeric(Valor) Then ValorC = Val(ValorC)
              If Nz(Valor) = ValorC Then RT_If_OR = True: Exit Function
           End If
        Next i

    End Function

    Cosas a tener en cuenta:
    - Funciona tambien con strings, hay que tener cuidado de pasar los valores de comparación entre comillas
    - Las formulas "<", ">", entre " - ", deben pasarse entre comillas
    - se pueden pasar tantos argumentos de comparación como se desee

    Se podría hacer para AND, pero no le veo mucho sentido, ya que las comparaciones AND suelen ser de dos campos distintos así que no ganaríamos nada, pero vamos, si se necesita se hace .. :-)




    ¿ Existe una tabla ?

    Aprovechando la tabla MSysObjects vamos a averiguar si existe o no una tabla.

    Aunque podría ser una rutina única yo he preferido dividirla en dos, una para las de la base local (CurrentDb) y otra para el resto de DataBases.


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Function RT_ExisteTabla(Nombretabla As String) As Boolean
        RT_ExisteTabla = False
        If DCount("*", "MSysObjects", "Name='" & Nombretabla & "' AND Type = 1") > 0 Then RT_ExisteTabla = True
    End Function


    Function RT_ExisteTablaOtraBD(RutaCompletaBD As String, Nombretabla As String, Optional Contraseña As String = "") As Boolean
    Dim Db As DAO.Database, Mitabla As DAO.Recordset
        RT_ExisteTablaOtraBD = False
        If Len(Contraseña) > 0 Then Contraseña = ";PWD=" & Contraseña
        On Error GoTo Errores
        Set Db = DBEngine.Workspaces(0).OpenDatabase(RutaCompletaBD, False, False, Contraseña)
        Set Mitabla = Db.OpenRecordset("SELECT * FROM MSysObjects WHERE Name='" & Nombretabla & "' AND Type = 1", dbOpenForwardOnly)
        If Mitabla.RecordCount > 0 Then RT_ExisteTablaOtraBD = True
        Mitabla.Close
        Set Mitabla = Nothing
        Db.Close
        Set Db = Nothing
        Exit Function

    Errores:
        If Err.Number = 3031 Then
           MsgBox "No es una contraseña válida", vbInformation, "El bissho dice..."
        End If
        Exit Function
    End Function



    Crear filtros con Listas con selección múltiple

    Con esta rutina automatizamos la creación de filtros / cláusulas WHERE a partir de una lista con selección múltiple (también se podría usar con una lista normal o un combo, aunque podría parecer que estamos matando mosquitos a cañonazos)

    Si tiene un solo valor lo crea como: = valor
    Si tiene varios: IN (valor1, valor2, valor3)

    Hay que indicarle si el campo es alfanumérico, con lo que pone los separadores adecuados: IN('valor1', 'valor2')


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura- 16:14 01/12/2013
    '---------------------------------------------------------------------------------------------
    Function RT_FiltroValoresLista(NombreFormulario As String, NombreLista As String, AlfanumericoSN As Boolean) As String
    Dim varItm As Variant, Separador As String

        RT_FiltroValoresLista = ""
        If AlfanumericoSN = True Then Separador = "'" Else Separador = ""
        '
        For Each varItm In Forms(NombreFormulario).Controls(NombreLista).ItemsSelected
        RT_FiltroValoresLista = RT_FiltroValoresLista & ", " & Separador & Forms(NombreFormulario).Controls(NombreLista).ItemData(varItm) & Separador
        Next
        ' quitamos la primera ,
        RT_FiltroValoresLista = Mid$(RT_FiltroValoresLista, 3)
        '
        If Forms(NombreFormulario).Controls(NombreLista).ItemsSelected.Count > 1 Then
        RT_FiltroValoresLista = " IN (" & RT_FiltroValoresLista & ")"
        Else
        RT_FiltroValoresLista = " = " & RT_FiltroValoresLista
        End If
    End Function


    Ejemplos de uso:

    Lanzar un formulario filtrado:
    DoCmd.OpenForm "FormClientes", , , "IdCliente" & RT_FiltroValoresLista(Me.Name, "Lista1", True)

    Lanzar un formulario y aplicarle un filtro (por ejemplo en el evento Load):
    Me.Filter = "IdCliente" & RT_FiltroValoresLista("Formulario1", "Lista1", True)
    Me.FilterOn = True


    Preparar una cláusula WHERE para una instrucción SQL
    SQL = "SELECT * FROM Clientes WHERE IdCliente" & RT_FiltroValoresLista(Me.Name, "Lista1", True)




    Fechas en VBA y SQL      23-jul-2017

    Vamos con las fechas, ... suelen atragantarse por no tener en cuenta dos conceptos básicos:

    1.- Las fechas son un número, dónde la parte entera nos indica el día a partir del 31 de diciembre de 1899 y la parte decimal indica la fracción transcurrida del día, nosotros tenemos que traducirla a horas, minutos, segundos -por ejemplo con la función Format (Valor, “hh:mm:ss”) o Format (Valor, “ttttt”)

    2.- Cuando tratamos con las fechas y VBA (y consultas SQL) podemos hacerlo de dos formas:
        - bien como un número
        - bien en notación americana #mm/dd/yyyy#

    Yo de siempre lo hago en notación americana, me es más fácil depurar después y no me enredo con los decimales (que recordemos que representan horas, minutos ...) que hace que las igualdades de fechas nos creen algún que otro problema.

    Por otro lado, hay que tener en cuenta que cuando estamos diseñando consultas SQL es mucho más rápido usar las fechas ‘limpias’ en vez de funciones, es decir:

        - En vez de:          WHERE Year(Fecha) = 2017
         ...hay que usar:    WHERE Fecha BETWEEN #01/01/2017# AND #12/31/2017#

        - En vez de:          WHERE Year(Fecha) = 2017 AND Month(Fecha) = 12
         ...hay que usar:    WHERE Fecha BETWEEN #12/01/2017# AND #12/31/2017#

        - En vez de usar Format(Fecha, “q”) para obtener un trimestre
         ...hay que usar:    WHERE Fecha BETWEEN #01/01/2017# AND #03/31/2017


    Dicho esto vamos con las funciones más habituales que vamos a usar en una aplicación (por lo menos las que yo uso), el listado de las mismas está al final con todas agrupadas, para que sea más fácil su uso:

    RT_PrimerDiaSemana. Dada una fecha devuelve el primer día de la semana que contiene a esa fecha

    RT_PrimerDiaMes. Dada una fecha devuelve el primer día del mes que contiene a esa fecha

    RT_PrimerDiaAño. Dada una fecha devuelve el primer día del año que contiene a esa fecha

    RT_UltimoDiaSemana. Dada una fecha devuelve el último día de la semana que contiene a esa fecha

    RT_UltimoDiaMes. Dada una fecha devuelve el último día del mes que contiene a esa fecha

    RT_UltimoDiaAño. Dada una fecha devuelve el último día del año que contiene a esa fecha

    RT_Bisiesto. Nos devuelve si es bisiesto o no el año pasado como parámetro. De entre las varias formas que hay de calcularla me gustó la que sugirió Emilio Sancha: ¿cuántos días tiene el año 365 ó 366?

    RT_DiasLaborables. Me devuelve el número de días laborables (de lunes a viernes) que hay entre dos fechas




    Y ahora las que uso para SQL:


    RT_FechaSQL. Me devuelve una fecha debidamente formateada en formato americano.

        Si el valor de MiFecha es 23-julio-2017:
           “ ... WHERE FECHA = “ & RT_FechaSQL(MiFecha) & “ ...”
        devuelve
           “ ... WHERE FECHA = #07/23/2017# .... “


    RT_HoraSQL. Me devuelve una hora debidamente formateada para su uso en SQL.

        Si el valor de MiHora = 17h 35’:
           “ ... WHERE CampoHora = “ & RT_ HoraSQL (MiHora) & “ ...”
        devuelve
           “ ... WHERE CampoHora = #17:35# .... “


    RT_BetweenSQL. Me devuelve una cláusula BETWEEN a partir de las dos fechas pasadas como parámetros, en el caso de que no pasemos la 'fecha desde' le pone el valor 1-ene-1900 y si no le pasamos la 'fecha hasta' le pone el valor 31-dic-2300.

        Si el valor de MiFecha1 es 1-julio-2017 y el de MiFecha2 es 23-julio-2017:
           “ ... WHERE FECHA “ & RT_BetweenSQL(MiFecha1, MiFecha2) & “ ...”
        devuelve
           “ ... WHERE FECHA BETWEEN #07/01/2017# AND #07/23/2017# ...”

        Si el valor de MiFecha1 es 1-julio-2017 y el de MiFecha2 es nulo:
           “ ... WHERE FECHA “ & RT_BetweenSQL(MiFecha1, MiFecha2) & “ ...”
        devuelve
           “ ... WHERE FECHA BETWEEN #07/01/2017# AND #12/31/2300# ...”


    RT_BetweenMes. Me devuelve una cláusula BETWEEN desde el primer hasta el último día del mes a partir de la fecha pasada como parámetro.

        Si el valor de MiFecha es 10-julio-2017:
           “ ... WHERE FECHA “ & RT_ BetweenMes (MiFecha) & “ ...”
        devuelve
           “ ... WHERE FECHA BETWEEN #07/01/2017# AND #07/31/2017# ...”


    RT_BetweenAno. Me devuelve una cláusula BETWEEN desde el primer día del año hasta el último a partir del año pasado como parámetro.

        Si el valor de MiAño es 2017:
           “ ... WHERE FECHA “ & RT_ BetweenAno (MiAño) & “ ...”
        devuelve
           “ ... WHERE FECHA BETWEEN #01/01/2017# AND #12/31/2017# ...”



    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------

    Function RT_PrimerDiaSemana(DiaReferencia As Date) As Date
         RT_PrimerDiaSemana = DateAdd("d", (Format(DiaReferencia, "w", vbMonday) - 1) * -1, DiaReferencia)
    End Function

    Function RT_PrimerDiaMes(Dia As Date) As Date
         RT_PrimerDiaMes = DateSerial(Year(Dia), Month(Dia), 1)
    End Function

    Function RT_PrimerDiaAño(Dia As Date) As Date
         RT_PrimerDiaAño = DateSerial(Year(Dia), 1, 1)
    End Function

    Function RT_UltimoDiaSemana(DiaReferencia As Date) As Date
         RT_UltimoDiaSemana = DateAdd("d", 7 - (Format(DiaReferencia, "w", vbMonday)), DiaReferencia)
    End Function

    Function RT_UltimoDiaMes(Dia As Date) As Date
         RT_UltimoDiaMes = DateSerial(Year(Dia), Month(Dia) + 1, 1)
         RT_UltimoDiaMes = DateAdd("d", -1, RT_UltimoDiaMes)
    End Function

    Function RT_UltimoDiaAño(Dia As Date) As Date
         RT_UltimoDiaMes = DateSerial(Year(Dia), 12, 31)
    End Function

    Function RT_Bisiesto(Año As Integer) As Boolean
         RT_Bisiesto = False
         If Format(DateSerial(Año, 12, 31), "y") = 366 Then RT_Bisiesto = True
    End Function

    Function RT_DiasLaborables(FechaInicio As Date, FechaFinal As Date) As Integer
    Dim FechaBucle As Date, DiasLaborables As Integer
         For FechaBucle = FechaInicio To FechaFinal
             If Weekday(FechaBucle) = vbSaturday Or Weekday(FechaBucle) = vbSunday Then
                 Else
                     DiasLaborables = DiasLaborables + 1
             End If
         Next
         '
         RT_DiasLaborables = DiasLaborables
    End Function

    Function RT_FechaSQL(fecha As Date) As String
         RT_FechaSQL = "#" & Format(fecha, "mm/dd/yyyy") & "#"
    End Function

    Function RT_HoraSQL(Hora As Date) As String
         RT_HoraSQL = "#" & Format(Hora, "hh:mm") & "#"
    End Function

    Function RT_BetweenSQL(FDesde, FHasta) As String
    ' si no hay fechas ponemos desde el 1900 hasta el año 2300 según corresponda desde/hasta
         RT_BetweenSQL = " BETWEEN " & RT_FechaSQL(IIf(IsDate(FDesde), FDesde, DateSerial(1900, 1, 1))) & _
                         " AND " & RT_FechaSQL(IIf(IsDate(FHasta), FHasta, DateSerial(2300, 12, 31)))
    End Function

    Function RT_BetweenMes(FechaReferencia As Date) As String
         RT_BetweenMes = " BETWEEN " & RT_FechaSQL(RT_PrimerDiaMes(FechaReferencia)) & " AND " & RT_FechaSQL(RT_UltimoDiaMes(FechaReferencia))
    End Function

    Function RT_BetweenAno(Año As Long) As String
         RT_BetweenAno = " BETWEEN " & RT_FechaSQL(DateSerial(Año, 1, 1)) & " AND " & RT_FechaSQL(DateSerial(Año, 12, 31))
    End Function





    Usar propiedades como constantes persistentes

    A veces necesitamos guardar valores asociados en una aplicación, pero no nos interesa guardarlos en tablas (la típica TParametros) para evitar su uso (o conocimiento) por parte del usuario. Por ejemplo:

    - guardar una ruta desde la que se importan o guardan frecuentemente archivos
    - guardar un valor de entrada a un formulario, de forma que al volver a entrar en él se sitúe en el mismo sitio
    - guardar la password de la aplicación (convenientemente disfrazada y encriptada)
    - ...


    Para ello vienen muy bien las propiedades de Access ("Properties"):

    - las podemos crear y borrar a nuestro antojo
    - son persistentes, no perdemos su valor al cerrar la aplicación, en la siguiente ejecución están ahí
    - son independientes por cada aplicación, es decir, en una aplicación compartida (Back-End <-> Front-End), el valor de una propiedad (variable) cualquiera es independiente para cada uno de los Front-End que tengamos (por ejemplo, guardar el último usuario que usó el aplicativo y sacar su valor al volverlo a abrir)
    - a un usuario normal le es muy difícil (por no decir imposible) acceder a ellas y menos modificarlas
    - y si tenemos un poquito de arte, a un usuario profesional le será hasta cierto punto fácil acceder a ellas, pero imposible manipularlas ...


    Estas propiedades pueden ser de distintos tipos: string, boolean, fecha, numérica (integer, single, double, ...), las definimos en el momento de crearlas.


    Yo nombro a las rutinas de lectura como:

       RT_PropiedadTIPO, dónde TIPO me dice si es string, fecha, etc
       y las de re-escritura como: RT_PropiedadTIPOWR


    Eso significaría que para asignar la fecha de última ejecución a un campo de un formulario bastaría con:

       Me.FechaUltimaEjecucion = RT_PropiedadFecha("NombreVariableFechaUltimaEjecucion")


    Y para cambiarle el valor:

       RT_PropiedadFechaWR "NombreVariableFechaUltimaEjecucion", Me.FechaUltimaEjecucion


    Estas son las que uso yo habitualmente, como veréis no hay una rutina de creación, ya que es más práctico crearla directamente en el caso de que no exista. También hay una rutina para poder borrarlas de una en una.



    Leemos el valor de una propiedad Booleana:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura- Leemos valor de una propiedad Booleana
    '---------------------------------------------------------------------------------------------

    Function RT_PropiedadBoolean(NombrePropiedad As String) As Boolean
    Dim prp As Property
       '** Comprueba la existencia de la propiedad y si no existe la crea
         On Error GoTo Errores_Propiedad
         RT_PropiedadBoolean = CurrentDb.Properties(NombrePropiedad)
         On Error GoTo 0
         Exit Function

       '** Tratamiento errores
    Errores_Propiedad:
         If Err = 3270 Then 'La propiedad no está creada
           Set prp = CurrentDb.CreateProperty(NombrePropiedad, dbBoolean, False, False)
           CurrentDb.Properties.Append prp
           RT_PropiedadBoolean = False
          Else
           MsgBox "Error de creacion de propiedad, nº : " & Err, vbCritical, "TECSYS S.L."
         End If
    End Function

    Re-escribimos el valor de una propiedad Booleana:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura- Reescribimos el valor de una propiedad Booleana
    '---------------------------------------------------------------------------------------------

    Function RT_PropiedadBooleanWR(NombrePropiedad As String, Valor As Boolean)
    Dim prp As Property
       '** Asigna valor a la propiedad si no existe la crea
         On Error GoTo Errores_Propiedad
         CurrentDb.Properties(NombrePropiedad) = Nz(Valor, False)
         On Error GoTo 0
         Exit Function

       '** Tratamiento errores
    Errores_Propiedad:
         If Err = 3270 Then 'La propiedad no está creada
           Set prp = CurrentDb.CreateProperty(NombrePropiedad, dbBoolean, Valor, False)
           CurrentDb.Properties.Append prp
          Else
           MsgBox "Error de creacion de propiedad, nº : " & Err, vbCritical, "TECSYS S.L."
         End If
    End Function

    Borramos una propiedad:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura- Borramos una propiedad
    '---------------------------------------------------------------------------------------------

    Function RT_PropiedadBorrar(NombrePropiedad As String)
         CurrentDb.Properties.Delete NombrePropiedad
    End Function

    Para no hacerlo muy engorroso, todas las rutinas están en un fichero ...

    Bajar rutinas



    Generar números únicos en sustitución de los autonuméricos

    Access te facilita mucho la vida con los autonuméricos a la hora de generar los campos índice de una tabla, pero estos mismos autonuméricos te pueden dar algún 'susto', a la hora de compactar, de exportar tablas o la misma BD, por ello cuando ese número es significativo (por ejemplo el IdCliente) yo no los uso nunca. Otra cosa es cuando no significa nada, es decir ningún índice cuelga 'por debajo' de él, por ejemplo: en el Id de una linea de un pedido, ahí son super útiles.

    Una manera de generártelo es búscando el último número usado y sumarle uno:
       IdCliente = Dmáx("IdCliente", "Clientes") + 1

    Este método tiene un problema básico: la concurrencia de usuarios, es cuestión de tiempo que se genere el mismo IdCliente por dos usuarios simultáneamente, por ello yo me he creado una rutina para generar esos números que me garantice su 'unicidad'.


    Para ello, necesitamos una tabla de contadores:


    siendo el tamaño del campo Valor_con: Entero largo (LONG)




    y la siguiente rutina:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Sub RT_Modulo_Contadores(codigo As String, Numero As Variant)
    Dim i As Double, Mitabla As DAO.Recordset
    Set Mitabla = CurrentDb.OpenRecordset("SELECT * FROM [TContadores] WHERE Codigo_con = '" & codigo & "'")
    If Mitabla.RecordCount = 0 Then
             MsgBox "Error tabla contadores. Codigo : " & codigo, vbCritical, "TECSYS"
         Else
             On Error GoTo Error_rut
             Mitabla.LockEdits = True
             Mitabla.Edit
             Mitabla("Valor_con") = Mitabla("Valor_con") + 1
             Numero = Mitabla("Valor_con")
             Mitabla.Update
    End If
    Mitabla.Close
    Exit Sub

    Error_rut:
    For i = 1 To 50000: Next
    Resume
    Return

    End Sub

    para usarla (siendo 'EXPEDI' el registro que contiene el contador de la tabla EXPEDIENTES):
       RT_Modulo_Contadores "EXPEDI", IdExpediente


    Para el caso de que demos altas múltiples y necesitemos obtener varios números consecutivos:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Sub RT_Modulo_Contadores_Multiple(Codigo As String, Numero As Variant, Cuantos As Long)
    Dim i As Double, Mitabla As DAO.Recordset
    Set Mitabla = CurrentDb.OpenRecordset("SELECT * FROM [TContadores] WHERE Codigo_con = '" & Codigo & "'")
    If Mitabla.RecordCount = 0 Then
             MsgBox "Error tabla contadores. Codigo : " & Codigo, vbCritical, "TECSYS"
         Else
             On Error GoTo Error_rut
             Mitabla.LockEdits = True
             Mitabla.Edit
             Numero = Mitabla("Valor_con") + 1
             Mitabla("Valor_con") = Mitabla("Valor_con") + Cuantos
             Mitabla.Update
    End If
    Mitabla.Close
    Exit Sub

    Error_rut:
    For i = 1 To 50000: Next
    Resume
    Return

    End Sub

    para usarla, además de los parámetros anteriores le tendremos que decir cuántos números queremos, supongamos que sean 10:
       RT_Modulo_Contadores_Multiple "EXPEDI", IdExpediente, 10


    Para el caso de que demos altas múltiples y necesitemos obtener varios números consecutivos:

    Nota: lo que me garantiza que el número obtenido sea único es el bloqueo del registro que se realiza (Mitabla.LockEdits = True), en el caso de que este bloqueado el mismo, se realiza una pequeña rutina de espera y se vuelve a intentar el bloqueo del mismo. Llevo años usando este sistema y nunca me ha dado ningún problema.





    Averiguar siguiente autonumérico      1-jun-2017

    Por necesidades del guion he tenido que averiguar el número que me va a asignar un autonumérico al crear un registro, ya que tenía que crear registros en una segunda tabla dependientes de la primera (y por tanto de su id).

    No podía quitar el autonumérico, es decir no podía usar números únicos generados por mi (entrada anterior), además no podemos usar un DMax, ya que en entorno multiusuario otro usuario puede dar de alta otro registro y ¡adiós!, y tampoco funciona bien cuando hay de por medio un alta/baja de registro, vamos, que tiene su aquel.

    Así que bicheando un poquito encontré una manera de saberlo, no antes de crearlo, pero si en el momento justo después, lo que ya me vale para crear los registros hijos en las tablas dependientes.

    Hay que hacerlo con Recordset, pero bueno, tampoco es mayor problema:

    - suponiendo que el autonumérico sea el campo Id:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------

    Private Sub GrabaFichero()
    Dim Rs As DAO.Recordset, UltimoNumero As Long

         Set Rs = CurrentDb.OpenRecordset("Tabla")
         Rs.AddNew
             Rs!Campo1 = 8
             Rs!Campo2 = 12
         Rs.Update
         '
         Rs.Move 0, Rs.LastModified
         UltimoNumero = Rs!Id
         Rs.Close
    End Sub









    SQL

    Rutinas SQL, ejemplos de consultas, ...




    Encadenar valores de una tabla

    A veces tenemos la necesidad de agrupar en un solo campo todos los valores de un dato de la tabla, agrupadas según nuestras conveniencias (normalmente el valor id de la misma).

    Por ejemplo, cuando tenemos una tabla de asignaturas que imparte un profesor y queremos mostrarlo en una sola línea:




    Para ello necesitamos tener esta rutina declarada:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Function RT_Encadenar(Separador As String, Tabla As String, Campo As String, Optional Condición As String) As String
    '** Es un destrozo de una de Raipon
    '** RT_Encadenar(' - ', 'NombreTabla', 'CampoAVisualizar', 'Condicion')
    '** RT_Encadenar(' - ', 'Tabla LEFT JOIN Tabla1 ON Tabla.codi = Tabla1.codi1', 'Descripcion_tasi', 'Codprofesor_aspr = 10')
    '** RT_Encadenar(' - ', 'Tabla LEFT JOIN Tabla1 ON Tabla.codi = Tabla1.codi1', 'Descripcion_tasi', 'Codprofesor_aspr = ' & CampoTabla)
    Dim MiTablaRT As Recordset
    On Error Resume Next
       
         RT_Encadenar = ""
         '
         Set MiTablaRT = CurrentDb.OpenRecordset("SELECT " & Campo & " AS Resultado FROM (" & Tabla & ") WHERE " & Campo & " Is Not Null" & IIf(Len(Condición) > 0, " AND " & Condición, ""), dbOpenForwardOnly)
             If Err.Number > 0 Then
                 RT_Encadenar = ""
                 MiTablaRT.Close
                 Exit Function
             End If
         Do Until MiTablaRT.EOF
             If Len(RT_Encadenar) = 0 Then
                 RT_Encadenar = MiTablaRT!Resultado
               Else
                 RT_Encadenar = RT_Encadenar & Separador & MiTablaRT!Resultado
             End If
             MiTablaRT.MoveNext
         Loop
         MiTablaRT.Close
       
    End Function


    Y llamarla desde dónde necesitemos (puede ser una SELECT para un Recordset, dentro del generador de Consultas, etc) con los parámetros adecuados, es muy similar a una función de dominio. El parámetro tabla admite relacionarla con otras tablas (Tabla LEFT JOIN Tabla1....).

    ¡Mucho ojo al construir el parámetro de condiciones! ... hay que delimitar los campos correctamente con ' # según sean de texto, fechas, etc.





    Dentro de una SQL quedaría:


         SELECT Id, Nombre, Direccion, First(RT_Encadenar("-","TPR1","Valor","Profesor='" & [Profesor] & "'")) AS Asignaturas
         FROM TProfesores




    Lo que veis es una adaptación sobre el original que desarrolló Raipon y yo me he limitado a fusilarlo, bueno y a cambiar alguna cosilla xD.



                 Blog RAIPON. Original función encadenar





    Numerar una consulta

    Cuando necesitamos numerar una consulta lo podemos hacer de la siguiente manera:


         SELECT Id, Nombre, (SELECT Count(Id) FROM TFacturas AS T1 WHERE Id <= TFacturas.Id) AS NumOrden
         FROM TFacturas



    El problema es que ejecuta una subconsulta por cada registro que tiene la misma, eso significa que con tablas con muchos registros el tiempo de ejecución puede ser muy grande. ¿Cómo evitarlo?, usando una función (rutina de VBA) que nos permita numerarla sin ejecutar subconsultas.

    La rutina la tenemos que crear en un módulo independiente:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Public Function RT_NumerarSQL(nDato) As Long
    'variable que no se pierde entre las distintas llamadas
    Static nORDEN As Long
        
         If IsNull(nDato) Then 'si nDato es nulo: variable a cero y salida
             nORDEN = 0
             Exit Function
         End If

         nORDEN = nORDEN + 1
         RT_NumerarSQL = nORDEN

    End Function



    ¿Cómo funciona?:
    - primero le pasamos un valor nulo, esto hace que se inicie a cero la variable estática que será nuestro contador
    - después al pasarle un valor distinto de nulo simplemente suma una unidad a la variable estática anterior y nos la devuelve como valor de la función.

    Para dar los dos pasos a la vez usaremos una consulta de unión:


         SELECT Id, Nombre, RT_NumerarSQL(Null) AS NumOrden FROM TFacturas WHERE 1 = 0
         UNION ALL
         SELECT Id, Nombre, RT_NumerarSQL(Id) AS NumOrden FROM TFacturas



    Puede parecer complicado, pero es muy sencillo, además la función la podremos emplear con otras tablas.

    ¿Y que tiempo hemos ganado? he hecho una prueba con una tabla con 30.000 registros, abro un recordset con la consulta anterior y lo recorro hasta el último registro:

    - con el primer método se tardan 122 segundos
    - con el segundo 20

    La relación es de 6:1, merece la pena


    La idea de esto se la ví hace muuuuuchos años a un compi del foro del Buho: Marius Puig.




    Numerar una consulta por grupos      23-oct-2016

    Un caso particular de numerar una consulta es numerarla agrupando por valores, visualmente es más claro entender cuál es el resultado que se pretende obtener.

    Partiendo de esta tabla:





    Llegar a estos resultados:





    Esto si estamos en un informe no tiene ninguna ‘gracia’, se crea un campo =1 con suma continua por grupo y asunto resuelto, pero .... ¿cómo hacerlo en una consulta?.

    Para conseguirlo volvemos a usar una función desde una consulta, cosa que nos proporciona una flexibilidad enorme a la hora de conseguir nuestros propósitos.


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Public Function RT_NumerarParcialSQL(nDato) As Long
    'variable que no se pierde entre las distintas llamadas
    Static nCONTADOR As Long, nANTERIOR As String
        
         If IsNull(nDato) Then 'si nDato es nulo: Iniciamos valor
             nCONTADOR = 0
             nANTERIOR = ""
             Exit Function
         End If

         '- si nDato es igual al valor memorizado sumamos 1 al contador
         If nDato = nANTERIOR Then
             nCONTADOR = nCONTADOR + 1
        
           Else '- iniciamos valor y memorizamos el anterior
             nCONTADOR = 1
             nANTERIOR = nDato
         End If
         RT_NumerarParcialSQL = nCONTADOR

    End Function



    Y para llamarla:

    SELECT Pais, Nombre, RT_NumerarParcialSQL(Pais) AS OrdenParcial
    FROM TQ
    ORDER BY Pais;




    Crear un campo con suma continua

    Supongamos que necesitamos un campo que nos de la suma de otro campo registro a registro, esto en un informe está 'chupao',
    creamos un campo de 'suma continua' y asunto resuelto, pero, ¿cómo lo hacemos en una consulta?

    Esta es una manera:


         SELECT Id, Importe, (SELECT Sum(Importe) FROM TFacturas AS T1 WHERE Id <= TFacturas.Id) AS Arrastre
         FROM TFacturas



    Pero volvemos a tener el mismo problema (esta vez más gordo, como veremos en la comparación de tiempos) cada registro ejecuta una subconsulta y eso es mucho tiempo.


    Necesitamos una función para realizar la suma (muy similar en su funcionamiento a la que describimos en el post anterior para numerar consultas):


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Public Function RT_SumarSQL(nDato) As Double
    'variable que no se pierde entre las distintas llamadas
    Static nSUMA As Double
        
         If IsNull(nDato) Then 'si nDato es nulo: variable a cero y salida
             nSUMA = 0
             Exit Function
         End If

         nSUMA = nSUMA + nDato
         RT_SumarSQL = nSUMA

    End Function



    ¿Cómo funciona?:
    - primero le pasamos un valor nulo, esto hace que se inicie a cero la variable estática que será nuestro valor de suma acumulada
    - después al pasarle un valor distinto de nulo suma ese valor a la variable estática anterior y nos la devuelve como valor de la función.

    Nuestra consulta quedaría así:


         SELECT Id, Importe, RT_SumarSQL(Null) AS Arrastre FROM TFacturas WHERE 1 = 0
         UNION ALL
         SELECT Id, Importe, RT_SumarSQL(Importe) AS Arrastre FROM TFacturas



    Esta vez la comparación de tiempos es más dramática, usando la misma tabla que en el ejemplo anterior:

    - usando la rutina de suma continua tarda 20 segundos (lo mismo que en el ejemplo de numerar una consulta)
    - usando el primer método esta vez se nos va a 420 segundos (recordad que cada registro es más 'pesado' de calcular que el anterior)

    En este caso la relación es 21:1, juzgad vosotros mismos.

    Por cierto, cuántos más registros tenga, más abultada sera la diferencia en la relación de tiempo y en una relación no precisamente lineal, el doble de registros no nos quedara 40:1, seguramente sea al menos un 60:1.

    Hay que huir de este tipo de subconsultas, los resultados pueden ser desastrosos en tiempos de ejecución.





    Funciones personales en SQL

    Como hemos visto en los ejemplos anteriores, podemos usar funciones creadas por nosotros mismos dentro de las sentencias SQL que nos posibiliten obtener unos resultados que por medio de SQL (llamémosle simple) no somos capaces de obtener.

    Iré poniendo en este apartado ejemplos interesantes que nos ayuden a comprender como usarlas.



    Funciones personales en SQL (I)      30-oct-2016

    En el foro TODOEXPERTOS un usuario planteaba esta cuestión:

    A partir de una tabla con estos valores (ID = estación, Fecha, Tx = temperatura), quiero obtener los días consecutivos de cada estación que tengan la misma temperatura, se quiere mostrar los grupos de tres o más días. La tabla es ésta:





    El proceso para obtener los resultados pedidos plantea dos escollos importantes a salvar:
    1.- La comparación de los valores del registro actual con el anterior para saber si cumple los criterios para considerarlo dentro del grupo a mostrar (mismo ID, que sean días consecutivos, que tengan la misma temperatura, que sean al menos tres iguales).
    2.- La obtención de los registros que en el momento de analizarlos NO cumplen las condiciones pedidas pero si lo van a hacer en el futuro, es decir el primer y segundo registro no sabemos si vamos a querer obtenerlos hasta que no analicemos el tercero.

    Obviamente se puede hacer ‘por fuerza bruta’ usando un recordset y por cada registro leído analizar los que le preceden y los que le siguen para saber si cumple las condiciones, pero aparte de que pueda quedar farragosa la solución, puede ser muy pesada de ejecutar ya que según indica el usuario son muchos registros a analizar.

    Está claro que con una consulta nunca lo vamos a conseguir, pero usando una función (llamada desde nuestra consulta) se puede hacer de un modo aparentemente simple. El quid está en ‘agrupar’ los registros por un identificador -numérico en nuestro caso- que nos individualice los grupos y nos permita contar el número de repeticiones para poder obtener finalmente los registros que de desean.

    La función queda como sigue:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Function RT_Tab1(Id As Long, Fecha As Date, Temperatura As Single) As Long
    Static NumeroGrupo As Long
    Static IdOld As Long, FechaOld As Date, TemperaturaOld As Single

         'inicializamos contador con un valor nulo
         If Id = 0 Then
             NumeroGrupo = 0
             IdOld = 0
             FechaOld = DateSerial(1900, 1, 1)
             TemperaturaOld = 0
             RT_Tab1 = 0
             Exit Function
         End If
        
         'controlamos si pertenece al mismo grupo que el anterior
         If Id <> IdOld Or _
             Temperatura <> TemperaturaOld Or _
             Fecha <> DateAdd("d", FechaOld, 1) Then
                 NumeroGrupo = NumeroGrupo + 1
         End If
         '
         IdOld = Id
         FechaOld = Fecha
         TemperaturaOld = Temperatura
         '
         RT_Tab1 = NumeroGrupo
        
    End Function



    - Está divida en dos bloques, en el primero se inicializan los campos al llamarla con el valor cero, en el segundo realiza la agrupación en si misma

    Como hay varios pasos a dar he creado una pequeña función en VBA que se podrá llamar desde dónde se quiera o integrarla en el código dónde mejor nos venga:


    Public Sub Prueba()

         ' inicializamos los valores de la función
         RT_Tab1 0, Date, 0
        
         ' creamos una nueva tabla con los valores de agrupación
         CurrentDb.Execute "SELECT * INTO Tab1_C " & _
                           "FROM (SELECT ID, Fecha, Tx, RT_Tab1([Id],[Fecha],[Tx]) AS NGroup " & _
                           "FROM Tab1 ORDER BY ID, Fecha)"
        
         ' opción 1: extraemos los que cumplen en una nueva tabla
         CurrentDb.Execute "SELECT ID, Fecha, Tx INTO Tab1_D " & _
                           "FROM Tab1_C WHERE NGroup IN " & _
                           "(SELECT NGroup FROM Tab1_C GROUP BY NGroup HAVING Count(ID)>2)"
        
         ' opción 2: borramos los que no cumplen en la misma
         CurrentDb.Execute "DELETE * FROM Tab1_C WHERE NGroup IN " & _
                           "(SELECT NGroup FROM Tab1_C GROUP BY NGroup HAVING Count(ID)<3)"
        
    End Sub


    Para la obtención de los valores deseados se me presentaban dos opciones más o menos obvias:
    1.- Consulta de creación de la tabla final de resultados, en la cuál ya no se obtiene el campo que nos ha permitido agrupar los registros
    2.- Consulta que borra los registros que ‘nos sobran’ para obtener el resultado deseado en la misma tabla intermedia

    Como estamos hablando de que son muchos registros pienso que la que tendrá que tratar menos registros en este paso C es la opción c1, pero eso es cuestión de probar y medir tiempos.

    Esta es la tabla intermedia, obtenida por la primera consulta de agrupación:





    Y este el resultado, obtenida por la consulta de selección (opción 1):






    Funciones personales en SQL (II). Calcular una diferencia entre dos registros      17-dic-2016

    En el foro TODOEXPERTOS un usuario plantea como calcular una diferencia de un campo de un registro con otro campo del registro anterior.

    Abordemos el problema con una función personal, que tiene que hacer lo siguiente:
    - Cálculo de la diferencia del campo Ini con el campo Final del registro anterior (se ha memorizado anteriormente)
    - Memorizar el campo Final para la siguiente comparación


    La función que nos hará el trabajo es:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Public Function RT_DiferenciaSQL(nDatoIni, nDatoFin) As Long
    'variable que no se pierde entre las distintas llamadas
    Static ValorMemorizado As Long
        
         If IsNull(nDatoIni) Then 'si nDato es nulo: variable a cero y salida
             ValorMemorizado = 0
             Exit Function
         End If

         RT_DiferenciaSQL = CLng(nDatoIni) - ValorMemorizado
         ValorMemorizado = CLng(nDatoFin)

    End Function



    Partimos de esta tabla:




    Recordemos que para inicializar los campos lanzamos la función con el valor Null, con lo que la consulta que haga ambas cosas a la vez queda así:


        SELECT 1 AS Id, 0 AS KmIni, 0 AS KmFin, RT_DiferenciaSQL(null, 0) AS Dif FROM Tab1 WHERE 1 = 0
        UNION
        SELECT Id, KmIni, KmFin, RT_DiferenciaSQL([kmIni],[KmFin]) AS Dif FROM Tab1



    Y este será el resultado:








    Funciones personales en SQL (III). Desglose moneda      25-ago-2017

    Una cuestión que surge de cuando en cuando, que tiene su pequeño aquel ... y que podemos resolver con una consulta + una función personal es averiguar el desglose de una cantidad en sus partes fraccionarias (tanto billetes como monedas).

    Para ello necesitamos una tabla monedas, dónde tendremos guardado el desglose que exista en la moneda a usar, en el caso de euros:




    Por otro lado nos crearemos la función que realice el desglose:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------
    Public Function RT_DesgloseMoneda(nDato, ImporteInicial As Currency) As Long
    'variable que no se pierde entre las distintas llamadas
    Static ImpRestante As Currency
        
         If IsNull(nDato) Then 'si nDato es nulo: variable al valor inicial y salida
             ImpRestante = ImporteInicial
             Exit Function
         End If

         RT_DesgloseMoneda = Int(ImpRestante / nDato)
         ImpRestante = ImpRestante - (nDato * RT_DesgloseMoneda)

    End Function



    El calculo del desglose se base en ir 'eliminando' los distintos importes fraccionarios de mayor a menor, arrastrando el importe restante para el siguiente valor.

    Como vemos al pasar el valor Null lo que hace la función es memorizar el valor inicial a desglosar.

    Y una vez que tenemos esto lanzar la consulta que realice el trabajo:


        SELECT 0 AS Valor, RT_DesgloseMoneda (Null, 999.99) AS Unidades FROM Monedas WHERE 1 = 0
        UNION ALL
        SELECT Valor, RT_DesgloseMoneda (Valor, 0) AS Unidades FROM Monedas ORDER BY Valor DESC



    Así, para un valor de 999.99 obtenemos:











    Tabla Numeros

    Una tabla muy útil que debe estar en toda BD que se precie es la Tabla Números (o TNumeros, o TNums). Sirve para muchas cosas: búsqueda de huecos, repetición n veces de una instrucción, acotación de periodos fecha/año, sacar los periodos mensuales/anuales aunque no tengan datos, etc.

    Consiste en una tabla con un único campo que contiene los números desde 1 (hay gente que empieza en el cero) hasta dónde necesitemos (10.000 puede ser un buen número xD):





    Veamos unos ejemplos:




    TNumeros(I). Datos en un periodo anual      21-dic-2016

    Supongamos que necesitamos obtener los importes facturados mes a mes de un año, incluyendo los meses a cero (esto con una PIVOT se puede sacar con la cláusula IN 1, 2 ...12, pero una tabla de referencias cruzadas es más complicada de manejar, además de que hay muchas cosas que nos nos permite realizar).

    Lo primero será obtener la tabla con los importes mensuales y el número de mes (para su posterior relación con la Tabla Números) del año seleccionado:




    En segundo lugar obtenemos nuestra tabla con los doce meses:




    Y por último juntamos ambas:





    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------

         ' Importes anuales
         Xs = "SELECT Sum(Impneto_hfvar) AS Importe, Month([Fecha_hfvar]) AS MesC " & _
              "FROM Hfacturas " & _
              "WHERE Year([Fecha_hfvar]) = 2012 " & _
              "GROUP BY Month([Fecha_hfvar])"

         ' Tabla con los doce meses
         Ys = "SELECT Numero AS Mes " & _
              "FROM Tnumeros " & _
              "WHERE Numero Between 1 And 12"

         ' juntamos ambas
         Zs = "SELECT Mes, Importe " & _
              "FROM (" & Ys & ") AS T1 LEFT JOIN (" & Xs & ") AS T2 ON T1.Mes = T2.MesC " & _
              "ORDER BY Mes"
        
         ' consulta de creación de la tabla
         CurrentDb.Execute "SELECT * INTO Tresultados FROM (" & Zs & ")"

         ' ... Y en un recordset
         Set Rs = CurrentDb.OpenRecordset(Zs, dbOpenForwardOnly)





    TNumeros(II). Datos en un periodo bienal      21-dic-2016

    Vamos a complicar un poquito el ejemplo anterior, vamos a obtener los datos de dos años a la vez.

    Lo primero será obtener la tabla con los importes mensuales, el año y el mes (en este caso no filtramos el año de obtención, lo haremos después al cruzar los datos con la Tabla Números):




    En segundo lugar obtenemos nuestra tabla con los doce meses de los dos años seleccionados:




    Y por último juntamos ambas:





    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------

         ' Importes anuales
         Xs = "SELECT Sum(Impneto_hfvar) AS Importe, Year([Fecha_hfvar]) AS AñoC, Month([Fecha_hfvar]) AS MesC " & _
              "FROM HFacturas " & _
              "GROUP BY Year([Fecha_hfvar]), Month([Fecha_hfvar])"
        
         ' Tabla con los doce meses de los años que queremos seleccionar
         Ys = "SELECT TNumeros.Numero AS Año, TNumeros_Mes.Numero AS Mes " & _
              "FROM TNumeros, TNumeros AS TNumeros_Mes " & _
              "WHERE TNumeros.Numero Between 2011 And 2012 AND TNumeros_Mes.Numero Between 1 And 12"
             
         ' juntamos ambas
         Zs = "SELECT Año, Mes, Importe " & _
              "FROM (" & Ys & ") AS T1 LEFT JOIN (" & Xs & ") AS T2 ON (T1.Mes = T2.MesC) AND (T1.Año = T2.AñoC) " & _
              "ORDER BY Año, Mes"
        
         ' consulta de creación de la tabla
         CurrentDb.Execute "SELECT * INTO Tresultados FROM (" & Zs & ")"

         ' ... Y en un recordset
         Set Rs = CurrentDb.OpenRecordset(Zs, dbOpenForwardOnly)





    TNumeros (III). Resumen ingresos / gastos multi anual      23-abr-2021

    Otro ejemplo de como simplificar tareas complejas con la tabla Numeros. Nos piden que saquemos un resumen económico de nuestra empresa en un intervalo de años, teniendo en cuenta que los ingresos están en la tabla FacturacionClientes y los gastos en FacturacionProveedores.
     
    Podríamos pensar en usar una consulta de unión, pero se nos plantea el problema de que si un año no tiene ingresos ni gastos no aparecerá en nuestro resumen, así que … ¿cómo hacerlo?
     
    Se va a entender a la primera.
     
    Lo primero una consulta que nos acote los años que necesitamos sin huecos, para ello está nuestra Tnumeros:


    SQL1 = "SELECT Numero FROM Tnumeros WHERE Numero BETWEEN AñoInicio AND AñoFinal"
     

    Acto seguido dos consultas que nos den los totales de ingresos y gastos por año


    SQL2 = "SELECT Year(Fecha_cli) AS AñoCli, Sum(Importe_cli) AS SCli FROM FacturacionClientes GROUP BY Year(Fecha_cli)
    SQL3 = "SELECT Year(Fecha_fac) AS AñoPro, Sum(Importe_pro) AS SPro FROM FacturacionProveedores GROUP BY Year(Fecha_pro)
     

    Y ahora las juntamos todas en una:


    SELECT Numero, Nz(Scli, 0) AS Ingresos, Nz(Spro, 0) AS Gastos, Nz(SCli, 0) - Nz(Spro, 0) AS Resultado
    FROM ((" & SQL1 & ") AS TNum
    LEFT JOIN (" & SQL2 & ") AS T1 ON TNum.Numero = T1.Añocli)
    LEFT JOIN (" & SQL3 & ") AS T2 ON TNum.Numero = T2.AñoPro
     







    OTROS

    Pues eso, un cajón de sastre para ir metiendo lo que no se dónde colocar ... hasta que lo sepa ...




    Se ha producido el error ‘3188’ en tiempo de ejecución


    Un poquito de luz acerca de este error.

    Siguiendo el enunciado del mismo das los siguientes pasos:
    - buscas otro usuario que esté tocando el mismo campo de la BD
    - si estás trabajando solo y eso no es posible, buscas que no haya una ejecución oculta de Access procedente de un casque anterior
    - compruebas que la apertura de la BD no sea exclusiva
    - que estén bien definidos los bloqueos, etc, etc ....
    - ¡tiempo perdido!

    Resulta que hay un error documentado de Microsoft Access referente a los campos memo cuando superan los 2 Mb de tamaño, ocurre un error en el buffer de actualización que hace que no pueda actualizar los campos cuyo origen (ControlSource) sea este campo memo.

    Para evitar el error se indica que no deben realizarse dichas actualizaciones ¿? ... y que si hay que hacerlas se desconecte primero el cuadro de texto del formulario (Me.campo.ControlSource = ""), se realice la actualización y después se vuelva a conectar.

    Vale, ¿y si resulta que uno trabaja con campos desconectados y sigue ocurriendo el error?, unas cuantas vueltas y pruebas raras hasta que te das cuenta de que por ‘delante’ de este formulario dónde se actualiza el campo hay otro formulario continuo que hace referencia a ese campo de la BD (aunque sea de solo lectura, ediciones = false, adiciones = false, ...) ...

    Así que desconecto el cuadro de texto del formulario continuo, vuelvo a probar y ... voilà: funciona.

    Las instrucciones son como un Oráculo: siempre son correctas, pero nunca totalmente explícitas

    - Hay que desconectar (me.campo.ControlSource = "") TODOS los cuadros de texto que hagan referencia a este campo memo en TODOS los formularios que estén cargados en ese momento.

    En mi caso desconecto el cuadro de texto del primer formulario al lanzar el segundo (el que actualiza) y al cerrar el segundo formulario vuelvo a conectar el cuadro de texto del primero.




    Adjuntar tablas (solo las visibles)      7-jun-2017

    Partiendo de la clásica rutina de adjuntar tablas de otra BD:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------

    Private Sub CmdAdjuntar_Click()
         Dim MyDb As DAO.Database, i As Integr, gl_var As Variant
        
         '** Adjuntamos tablas. Todas excepto las que empiecen por Msys
         Set MyDb = DBEngine.Workspaces(0).OpenDatabase(Me.bdseleccionada)
         For i = 0 To MyDb.TableDefs.Count - 1
             If Left$(MyDb.TableDefs(i).Name, 4) <> "Msys" Then
                 gl_var = SysCmd(acSysCmdSetStatus, "Adjuntando tabla: " & MyDb.TableDefs(i).Name)
                 DoCmd.TransferDatabase acLink, "Microsoft Access", Me.bdseleccionada, acTable, MyDb.TableDefs(i).Name, MyDb.TableDefs(i).Name
             End If
         Next i
         gl_var = SysCmd(acSysCmdClearStatus)
        
         MsgBox "ADJUNTADAS TODAS LAS TABLAS", vbInformation, "El chino dice..:"
        
    End Sub


    Necesitaba modificarla de forma que no me adjuntara las tablas que en la otra BD estuvieran ocultas.

    - el primer paso fue buscar en la tabla el atributo oculto (Hidden .. o algo así): no existe

    - al buscar información en la red lo primero que aparece es usar el valor de la propiedad "Attributes" de la tabla:

             DbExterna.TableDefs("Mitabla").Properties("Attributes").Value

       que se supone que vale 0 (visible) o dbHiddenObject (Invisible) ...... pero, no es esa la propiedad que buscamos

    - lo siguiente fue buscar la propiedad como objeto Tabla y esa sí que está disponible:

             Application.GetHiddenAttribute(acTable, "Mitabla")

       … pero, el acceder a este atributo solo se puede realizar en la aplicación actual, no en una BD externa referenciada, así que hay que acceder a la misma por automatización y el acceso a las tablas se realiza usando la colección AllTables, ... esto nos permite eliminar el uso de la colección DbExterna.TableDefs, con lo que la rutina de adjuntar sólo las tablas visibles (y que no sean de sistema) queda así:


    '---------------------------------------------------------------------------------------------
    ' Autor : JESUS MANSILLA CASTELLS -Mihura-
    '---------------------------------------------------------------------------------------------

    Private Sub CmdAdjuntar_Click()
    Dim appAccess As Access.Application, ObjTab As AccessObject, Dbs As Object, V1 As Variant
        
         CmdDesconectar_Click
        
         Set appAccess = CreateObject("Access.Application")
         appAccess.OpenCurrentDatabase (Me.bdseleccionada)
         Set Dbs = appAccess.CurrentData
         '
         For Each ObjTab In Dbs.AllTables
             If Left$(ObjTab.Name, 4) <> "Msys" And _
                 appAccess.GetHiddenAttribute(acTable, ObjTab.Name) = False Then
                     'adjuntamos si es visible y no es una tabla de sistema "MSYSxxx"
                     DoCmd.TransferDatabase acLink, "Microsoft Access", Me.bdseleccionada, acTable, ObjTab.Name, ObjTab.Name
                     V1 = SysCmd(acSysCmdSetStatus, "Adjuntando tabla: " & ObjTab.Name)
             End If
         Next
        
         Set Dbs = Nothing
         Set appAccess = Nothing

         V1 = SysCmd(acSysCmdClearStatus)

         MsgBox "ADJUNTADAS TODAS LAS TABLAS", vbInformation, "El chino dice..:"

    End Sub





    Mensaje error en márgenes de los informes      9-sep-2020

    A todos nos fastidia que salga el siguiente mensaje:



    Siempre en impresos muy pillados con los márgenes, a mi me acaba de pasar con unas etiquetas y por mucho que nos peleemos con el informe acaba saliendo el mensajito de marras ...

    ¿ Podemos acabar con este incordio ? ... SI ... gracias a McPegasus, no es que él nos lo vaya a quitar, pero es el que me ha contado el truqui para hacerlo, oido al parche:
    - se crea el informe, una vez ajustado lo configuramos con una impresora PDF (en mi caso Microsoft Print to PDF)
    - nos creamos un nuevo informe en el cual incrustamos como subinforme el anterior
    - .... y voilá se acabaron los mensajes.

    P.D. a McPegasus le podéis encontrar aquí, en Bee Software, si, ha cambiado de re-encarnación pero sigue volando. Muchas gracias colega




    Tecsys Proyectos Informaticos, S.L.