Trucos y ejemplos de VBA para Microsoft Access

En esta página encontrarán algunos ejemplo de trucos de VBA (Visual Basic for Applications) que puedes utilizar en aplicaciones desarrolladas con la base de datos Microsoft Access. También puedes descargar los formularios, informes y códigos de ejemplo de Microsoft Access que encontrarás en esta página y disponer de ellos como quieras, ya sea para uso personal o profesional. Si necesitas soporte profesional aquí tienes una empresa de referencia: Microsoft Access. Servicios de soporte y desarrollo en Auditour.

Empecé a desarrollar aplicaciones con Microsoft Access en 1995 con la primera versión Access 2.0 y hasta el día de hoy, es decir 27 años. Recuerdo que fue fascinantes pasar de COBOL a Access como herramienta por la cantidad de cosas que se simplificaban.

Dado que siempre he sido autodidacta, tanto en Basic como en PHP hay dos cosas que siempre me han ido muy bien, ejemplos de las funciones y un libro de referencia. Os dejo una recomendación que os puede ser útil.

Microsoft Access VBA

Lista de temas: Bucles(3) - TableDefs(2) - Excel(1) - Fechas(4) - FileSystem(3) - Forms(8) - Informes(1) - MDB(3) - DAO(1) - Office(2) - Recordset(3) - SQL(2) - Strings(13) - email(1) - System(5) - Teoría(1) - URL(4) - IE Object(1) -

Bucles

Comandos de menú de Access - DoEvents en bucles - Listar los campos de una tabla -

Comandos de menú de Access

Código VBA para ver todos los comandos de las barras de menú de Access 2003. Este código puede ser útil cuando queremos personalizar las barras de menú....

Código para obtener todos los comandos de menú

Sub EnumerarComandos()
    Dim cb  As CommandBar
    Dim cbc As CommandBarControl
    For Each cb In Application.CommandBars
        Debug.Print cb.Name
        For Each cbc In cb.Controls
            Debug.Print cbc.Caption
        Next
    Next
End Sub

DoEvents en bucles

Mantener el control de un bucle con DoEvents evita que se bloquee Access en bucles largos y podamos recuperar el control del sistema....

En algunas ocasiones en un bucle Do While o For Next largo queremos hacer un display de algún campo para poder seguir la evolución del mismo sin embargo vemos como al poco rato la visualización se detiene y no responde hasta el final, con lo cual da la sensación de que el proceso se ha quedado colgado. Para solucionarlo y mantener la visualización de control en el bucle basta con añadir dentro del mismo la instrucción DoEvents.

Do While 
   ... 
   ... 
   DoEvents
Loop

Sin embargo está comprobado que llamar a DoEvents en cada bucle ralentiza mucho el proceso. En pruebas hechas con Excel VBA una macro puede multiplicar por 4 el tiempo de ejecución. Pôr eso recomienda lanzar cada n ejecuciones del bucle y poner el valor Application.Hecho a False para que no refresque pantalla constantemente.

Application.Echo False
Do While 
   ... 
   ... 
   ind=ind+1
   If ind Mod 100 = 0 Then
       DoEvents
   End If
Loop
Application.Echo True

Listar los campos de una tabla

Un bucle For Each para listar los campos de una tabla de Access...

Modo resumido

Sub CamposDeTabla()
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Set dbs = OpenDatabase("i:intex winbol2000E999car.mdb")
    Set tdf = dbs.TableDefs("CART0001")
    For Each fld In tdf.Fields
        Debug.Print fld.Name
    Next
    Set fld = Nothing
    Set tdf = Nothing
    dbs.Close
End Sub

TableDefs

Listar los campos de una tabla - Reconectar tablas vinculadas -

Listar los campos de una tabla

Un bucle For Each para listar los campos de una tabla de Access...

Modo resumido

Sub CamposDeTabla()
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Set dbs = OpenDatabase("i:intex winbol2000E999car.mdb")
    Set tdf = dbs.TableDefs("CART0001")
    For Each fld In tdf.Fields
        Debug.Print fld.Name
    Next
    Set fld = Nothing
    Set tdf = Nothing
    dbs.Close
End Sub

Reconectar tablas vinculadas

Una rutina de código para actualizar la ruta de tablas vinculadas a otra base de datos. La rutina se ejecuta automáticamente si detecta error. Es útil cuando se envían aplicaciones a clientes y éstos ponen las base de datos Access en una ruta diferente....

Ejemplo:

Public Function Inicio()
    ConectarTablas
    Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("Tabla1")
    gblState = rst!state_id
    DoCmd.OpenForm rst!FormularioInicio
    rst.Close
End Function
Sub ConectarTablas()
    On Error GoTo ErrorSub
    Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("Tabla1")
    rst.Close
    Exit Sub
ErrorSub:
    Dim tdf As DAO.TableDef
    For Each tdf In CurrentDb.TableDefs
        If tdf.Attributes = 1073741824 Then ' Solo refresca tablas vinculadas.
            ConectarTDF tdf
        End If
    Next
End Sub
Sub ConectarTDF(tdf As TableDef)
    On Error GoTo ErrorSub
    tdf.Connect = ";DATABASE=" & CurrentProject.Path & "\BaseDeDatos.accdb"
    tdf.RefreshLink
    Exit Sub
ErrorSub:
    Debug.Print tdf.Name & ": " & Err.Description
End Sub

Fecha: 17-03-2024

Excel

Buscar valor en celda -

Buscar valor en celda

Bucle para buscar el valor de una celda dentro de una fila...

    With wks.Rows(indRow)
        Set rngCel = .Find(0, lookin:=xlValues)
        If Not rngCel Is Nothing Then
            'firstAddress = c.Address
            Do
                Set rngCel = .FindNext
            Loop While Not rngCel Is Nothing
        End If
    End With

Fechas

Buscar un registro en Access 2003 - Convertir minutos a formato Fecha (Date) - Minutos a formato HH:NN string - Primer y último día de la semana -

Buscar un registro en Access 2003

Este código de VBA en Access 2003 combina la función de buscar un registro en función de un campo de fecha de un formulario y en que caso de no encuentre el dato que vaya a nuevo registro....

Para seleccionar la Fecha se utiliza un control Calendar llamado Calendario.

    Dim lngReg As Long
    lngReg = DCount("[fecha]", "Facturas", "[fecha] = #" & Format(Calendario.Value, "mm-dd-yy") & "#")
    If lngReg <= 0 Then
        DoCmd.GoToRecord acActiveDataObject, , acNewRec
      Else
        Fecha.SetFocus
        DoCmd.FindRecord Calendario.Value, acEntire, False, acSearchAll, , acCurrent
    End If

Convertir minutos a formato Fecha (Date)

Una sencilla función para convertir minutos a formato hh:nn y así poderlo guardar en un campo cuyo tipo de datos es Date en una tabla de Access. ...

Function ConvertMinutesToDate(Minutos As Integer) As Date
    Dim intHor As Integer
    Dim intMin As Integer
    intHor = Int(Minutos / 60)
    intMin = Minutos - (intHor * 60)
    ConvertMinutesToDate = CDate(intHor & ":" & intMin & ":00")
End Function

Notas: Si lo minutos suman más de un día hay que ajustar la función. Suelo usar la función en aplicaciones que importan tareas, por eso aún no tengo hecho el ajuste de los días pero se puede llegar a realizar.

Minutos a formato HH:NN string

En programas de gestión de tareas nos podemos encontrar con que tenemos que ofrecer un total de minutos que es superior a las 24 horas. Con esta función devolvemos un string con las horas acumuladas y minutos...

Function HorasMinutosString(Minutos As Integer) As String
    Dim intHor As Integer
    Dim intMin As Integer
    intHor = Int(Minutos / 60)
    intMin = Minutos - (intHor * 60)
    HorasMinutosString = Format(intHor, "#00") + ":" + Format(intMin, "00")
End Function

Primer y último día de la semana

Como determinar el primer y el último día de la semana en VBA...

El caso es el siguiente, tenemos un formulario de Microsoft Access 2003 con dos campos de fecha Desde/Hasta. Queremos que cuando se abra el formulario automáticamente se visualicen en los campos Desde y Hasta el primer y último día de la semana o del mes según la fecha en que lo hacemos para poder obtener informes en curso. Deberíamos poner el siguiente código en el evento Form_Load()

txtDesdeFecha = Date - Weekday(Date, vbUseSystemDayOfWeek) + 1
txtHastaFecha = Date - Weekday(Date, vbUseSystemDayOfWeek) + 7

FileSystem

Leer archivos grandes con VBA - Seleccionar un archivo - Unir archivos de texto -

Leer archivos grandes con VBA

Un ejemplo de lectura de archivos grandes sin que se bloquee el PC por falta de recursos. Probado con un archivo de 4 GB...

Rutina de lectura:

Public Sub ImportV2()
    Dim strReg As String
    Dim strFile As String
    Dim fso As FileSystemObject
    Dim fil As Object
    strFile = "C:\Users\username\Downloads\file.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fil = fso.OpenTextFile(strFile, 1)
    Do Until fil.AtEndOfStream
        strReg = fil.ReadLine
    Loop
    fil.Close
End Sub

Seleccionar un archivo

Cómo seleccionar un archivo desde un formulario de Microsoft Access usando VBA....

Recordar que se requiere una referencia a la librería: Microsoft Office 16.0 Object Library.

Public Function SelectFileSample() As String
   ' Requires reference to Microsoft Office 16.0 Object Library.
   Dim fDialog As Office.FileDialog
   Dim varFile As Variant
   Dim fso As FileSystemObject
   ' Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
        '.InitialFileName = strCarpeta ' Default folder
        ' Allow user to make multiple selections in dialog box
        .AllowMultiSelect = False
        ' Set the title of the dialog box.
        .Title = "Seleccionar un fichero"
        ' Clear out the current filters, and add our own.
        .Filters.Clear
        ' Sample for filters
        '.Filters.Add "Image JPG", "*.JPG"
        '.Filters.Add "Image PNG", "*.PNG"
        .Filters.Add "Todos los archivos", "*.*"
        ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
        If .Show = True Then
           'Loop through each file selected and add it to our list box.
           For Each varFile In .SelectedItems
             'Me.FileList.AddItem varFile
              SelectFileSample = varFile
           Next
        Else
           MsgBox "No saleccionado ningún fichero", vbInformation, "Select File"
        End If
   End With
End Function

Unir archivos de texto

Bucle para unir ficheros de texto que están en una misma carpeta, en este caso .csv en uno solo....

El siguiente código asume que todos tus archivos CSV tienen la misma estructura (es decir, las mismas columnas en el mismo orden). El proceso básicamente abre cada archivo CSV en la carpeta especificada, lee su contenido y lo escribe en un nuevo archivo CSV.

    Dim rutaCarpeta As String
    Dim archivo As String
    Dim nombreArchivoUnido As String
    Dim textoArchivo As String
    Dim primeraLinea As Boolean
    Dim numArchivo As Integer
    Dim fso As Object, ts As Object, tsUnion As Object

    rutaCarpeta = "C:\TuCarpeta\" ' Modifica con la ruta de tu carpeta
    nombreArchivoUnido = rutaCarpeta & "ArchivoUnido.csv" ' Nombre del archivo final

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tsUnion = fso.CreateTextFile(nombreArchivoUnido, True)

    archivo = Dir(rutaCarpeta & "*.csv")
    primeraLinea = True

    Do While archivo <> ""
        ' Evita leer el archivo unido si ya existe en la carpeta
        If archivo <> "ArchivoUnido.csv" Then
            numArchivo = numArchivo + 1
            Set ts = fso.OpenTextFile(rutaCarpeta & archivo, ForReading)

            ' Omitir la primera línea del archivo si no es el primero (suponiendo que es el encabezado)
            If Not primeraLinea Then ts.ReadLine

            ' Leer el contenido del archivo y escribirlo en el archivo unido
            Do While ts.AtEndOfStream <> True
                textoArchivo = ts.ReadLine
                tsUnion.WriteLine textoArchivo
            Loop

            ts.Close
            primeraLinea = False
        End If

        archivo = Dir() ' Siguiente archivo
    Loop

    tsUnion.Close
    Set ts = Nothing
    Set tsUnion = Nothing
    Set fso = Nothing

    MsgBox numArchivo & " archivos han sido unidos en " & nombreArchivoUnido, vbInformation
End Sub

Este código realiza las siguientes tareas:

Establece la ruta de la carpeta donde se encuentran los archivos CSV y el nombre del archivo CSV unido final.
Utiliza un objeto FileSystemObject para trabajar con archivos y carpetas.
Abre cada archivo CSV en la carpeta, omite la primera línea para todos los archivos excepto el primero (asumiendo que es un encabezado) y escribe su contenido en un nuevo archivo CSV.
Continúa este proceso para todos los archivos CSV en la carpeta.
Muestra un mensaje al finalizar, indicando cuántos archivos han sido unidos.

Asegúrate de modificar rutaCarpeta con la ruta correcta de tu carpeta de archivos CSV. También, este código omite el encabezado de todos los archivos excepto el primero; si tus archivos no tienen encabezados o quieres incluirlos todos, puedes ajustar la lógica acordemente. Este código es un punto de partida básico. Dependiendo de tus necesidades específicas, podrías necesitar hacer ajustes, especialmente si los archivos CSV tienen diferentes estructuras o requieres un procesamiento de datos más complejo.

Forms

Colección Forms - Como crear un hipervínculo en un formulario - Evento Unload - Filtro y orden de registros de un formulario - Ir al final de un campo - Microsoft Flexgrid en Access 365 con Windows 10 - Propiedad ControlSource en un Formulario Access - Vibración de letras en formularios de Microsoft Access -

Colección Forms

Para recorrer con un bucle la colección de formularios abiertos en Access usando VBA, puedes utilizar el objeto Forms, el cual es una colección que representa todos los formularios que están actualmente abiertos en tu aplicación de Access. Aquí te muestro cómo hacerlo con un bucle For Each....

Código de ejemplo:

Sub RecorrerFormulariosAbiertos()
    Dim frm As Form
    ' Recorre cada formulario en la colección de formularios abiertos
    For Each frm In Forms
        ' Aquí puedes trabajar con el formulario actual referenciado por "frm"
        ' Por ejemplo, imprimir el nombre del formulario en la ventana Inmediato
        Debug.Print frm.Name
    Next frm
End Sub

Este código define un subprocedimiento llamado RecorrerFormulariosAbiertos. Dentro del procedimiento, se declara una variable frm de tipo Form. Luego, el bucle For Each recorre cada elemento de la colección Forms, que representa todos los formularios abiertos en el momento de ejecutar el código. En cada iteración del bucle, puedes realizar operaciones con el formulario actual a través de la variable frm. En este ejemplo, el nombre de cada formulario abierto se imprime en la ventana Inmediato de la ventana del Editor de VBA, lo cual es útil para fines de depuración o para obtener un listado rápido de los formularios que están abiertos. Recuerda que este código solo funcionará cuando se ejecute desde dentro de la misma aplicación de Access, ya que accede directamente a los objetos de la aplicación en ejecución.

Como crear un hipervínculo en un formulario

Hay varias formas de crear un hipervínculo en un formulario de Visual Basic y abrir una página Web que te explico en este contenido....

Una muy sencilla es la siguiente:

Crear una label en el formulario y en el Caption poner el texto que queramos, la dirección o el nombre de la página que queremos abrir.
Cambiar la propiedad Font poniendo la característica de subrayado
Cambiar la propiedad ForeColor y ponerle Azul
Cambiar la propiedad MouseIcon y buscar un icono típico de Hipervínculo por ejemplo en: C:\Archivos de programa\Microsoft Visual Studio\Common\Graphics\Cursors
Cambiar la propiedad MousePointer a 99 (personalizado)

Crear en el formulario el Evento Click y poner una llamada a la API ShellExecute pasando como parámetro la URL que queremos abrir.

Evento Unload

Para guardar los parámetros de los campos de un formulario en Access antes de cerrarlo, puedes utilizar el evento Unload del formulario. Este evento se produce antes de que el formulario se cierre y los controles aún están accesibles, lo que te permite guardar los valores de los campos....

Aquí tienes un ejemplo de cómo podrías hacerlo:

Abrir el editor de VBA:
- Abre tu base de datos de Access.
- Presiona ALT + F11 para abrir el Editor de VBA.
Agregar el código en el evento Unload del formulario:
- En el Editor de VBA, busca tu formulario en el explorador de proyectos.
- Haz doble clic en el nombre de tu formulario para abrir el módulo de código asociado.
- Selecciona Form en el menú desplegable del lado izquierdo y luego selecciona Unload en el menú desplegable del lado derecho.
Escribir el código:
- Agrega el código necesario para guardar los parámetros de los campos en el evento Unload. Aquí tienes un ejemplo sencillo de cómo hacerlo:

Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo ErrorHandler

    ' Suponiendo que tienes un campo de texto llamado "txtNombre"
    Dim nombre As String
    nombre = Me.txtNombre.Value

    ' Guarda el valor en una tabla o variable global según tus necesidades
    ' Aquí mostramos un ejemplo de cómo guardarlo en una tabla llamada "Parametros"
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Parametros", dbOpenDynaset)
    
    rs.AddNew
    rs!Nombre = nombre
    rs.Update
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing

    Exit Sub

ErrorHandler:
    MsgBox "Ocurrió un error: " & Err.Description, vbExclamation
End Sub

Filtro y orden de registros de un formulario

Cómo hacer un filtro por un campo y ordenar los registros del formulario...

Form_frmPersonasTareasLista.Filter = "[codigo estado]='PDTE'"
Form_frmPersonasTareasLista.FilterOn = True
Form_frmPersonasTareasLista.OrderBy = "FechaAlta DESC"
Form_frmPersonasTareasLista.OrderByOn = True

Ir al final de un campo

Como entrar en un TextBox de Access y que se ponga al final del campo sin seleccionar todo el texto....

Private Sub Observaciones_Click()
    Observaciones.SelLength = 0
    Observaciones.SelStart = Len(Observaciones)
End Sub

Microsoft Flexgrid en Access 365 con Windows 10

El control OCX Microsoft FlexGrid lo he usado con mucha frecuencia en mis aplicaciones con Access. Es un excelente control que con un gran número de opciones que permite utilizarlo para muchas funciones. Sin embargo las sucesivas versiones de Windows y Office hicieron que diera error. Ahora en septiembre de 2020 se ha estabilizado y es el momento de saber como funciona correctamente....

Cuando está en un formulario los datos son:

Clase OLE: MSFlexGrid
Clase: MSFlexGridLib.MSFlexGrid.1

Propiedad ControlSource en un Formulario Access

Ejemplo de la Propiedad ControlSource en un campo de un Formulario Access....

Ver código:

NombreDelCampo1 
=[NombreDelCampo1]*2 
=[NombreDelCampo1]*[NombreDelCampo2] 
=[NombreDelCampo1]*[NombreDelCampo2].[Column](1) 
=IIf([NombreDelCampo1]>0, "Valor Verdadero", "Valor Falso")

Vibración de letras en formularios de Microsoft Access

Las letras de la aplicación Microsoft Access vibran continuamente. No pasa en otras aplicaciones ni de Office ni otros programas. Buscando las soluciones habituales para Windows 10 tampoco daban resultado. La solución era muy curiosa....

Resulta que el molesto parpadeo de las letras de la pantalla se debía a la fuente utilizada en el formulario de Microsoft Access. Solo pasaba con la tipografía MS Sans Serif, al cambiar a Calibri u otras desparece inmediatamente. Espero que este tip os sea de ayuda.

Informes

Campos calculados en informes -

Campos calculados en informes

Control de campos calculados en informes de Access...

Cuando queremos restringir los valores que nos devuelve un informe de Microsoft Access en función del valor de un campo es sencillo, ponemos las condiciones en una consulta que actúe como fuente de informe y ya está. Sin embargo el tema se complica un poco cuando el control lo que queremos realizar en función del valor de un campo que vamos a calcular en la sección Detalle del Report. En este caso podemos hacerlo poniendo un campo de selección en el formulario, por ejemplo el fraTipo que se utiliza en el ejemplo y que pregunta por dos opciones (1.Todos los socios o 2.solo los pendiente de pago). Seguidamente en el evento Detalle_Format incluiremos el siguiente código:

    If Form_CLGI0201Cobros.fraTipo = 2 Then
        If txtPendiente = 0 Then
            Cancel = True
            Exit Sub
        End If
    End If

MDB

Convertir un MDB de Access a Texto - Documentar elementos de Microsoft Access - Todos los iconos de Access -

Convertir un MDB de Access a Texto

Esta es una pequeña utilidad desarrollada con Visual Basic que permite convertir a un fichero de texto una base de datos de Microsoft Access. El proceso crea una subcarpeta donde están las bases de datos y en la misma crea un fichero por cada una de la tablas del MDB. En principio se crean en formato csv pero modificando el parámetro de esta instrucción es posible obtener la información en otros formatos como acFormatActiveXServer, acFormatHTML, acFormatIIS, acFormatRTF, acFormatTXT, acFormatXLS:...

Instrucción:

app.DoCmd.OutputTo acOutputTable, tdf.Name,acFormatTXT, strFolderOutput & "\" & tdf.Name & ".txt"

Hay dos métodos posibles para la exportación el DoCmd.TransferText y el DoCmd.OutputTo, se pueden utilizar cualquiera de los dos. Aquí está el archivo para descargar y debajo el código del formulario (también hay un módulo en el proyecto con 2 funciones complementarias. MDB2txt Código del formulario:

Option Explicit
    Dim app  As Access.Application
    Dim dbs  As DAO.Database
    Dim tdf  As DAO.TableDef
    Dim strMDB2txt  As String
    Dim strSQL      As String
    Dim strFolderOutput As String
    Dim fso         As FileSystemObject

Private Sub Form_Load()
    'Me.Width = 6500
    'Me.Height = 3300
End Sub
Private Sub cmdMDB2txt_Click()
    cdgMDB2txt.DefaultExt = "mdb"
    cdgMDB2txt.ShowOpen
    strMDB2txt = ValidarString(cdgMDB2txt.FileName)
    If strMDB2txt <> "" Then
        txtMDB2txt = strMDB2txt
      Else
        txtMDB2txt = ""
    End If
End Sub
Private Sub cmdCancelar_Click()
    Unload Me
End Sub
Private Sub cmdConvertir_Click()
' Inicio de Proceso
    lblMDB2txt.Caption = "Iniciando proceso ..."
    Set app = New Access.Application
    app.OpenCurrentDatabase strMDB2txt
    Set fso = New FileSystemObject
    Set dbs = OpenDatabase(strMDB2txt)
    strFolderOutput = ArchivoInformacion(strMDB2txt, itxpath) & "\" & Mid(Dir(strMDB2txt), 1, (Len(Dir(strMDB2txt)) - 4))
    If fso.FolderExists(strFolderOutput) = False Then
        fso.CreateFolder strFolderOutput
    End If
' Procesar las Tablas
    For Each tdf In dbs.TableDefs
        GoSub ExportarTabla
    Next
' Cerrar Bases de Datos
    dbs.Close
    Set app = Nothing
    Set fso = Nothing
' Fin de Proceso
    MsgBox "Proceso Finalizado", vbInformation, "Convertir MDB a Texto"
    txtMDB2txt = ""
    lblMDB2txt.Caption = ""
    Exit Sub
ExportarTabla:
    If tdf.Attributes = dbAttachedTable Then Return
    If LCase(Left(tdf.Name, 4)) = "msys" Then Return
    lblMDB2txt.Caption = "Convirtiendo " & tdf.Name
    app.DoCmd.TransferText acExportDelim, "", tdf.Name, strFolderOutput & "\" & tdf.Name & ".csv"
    'app.DoCmd.OutputTo acOutputTable, tdf.Name,acFormatTXT, strFolderOutput & "\" & tdf.Name & ".txt"
    Me.Refresh
    Return
End Sub

Documentar elementos de Microsoft Access

Los elementos de una base de datos Tablas, Formularios, etc. se denominan Documents y se agrupa en Containers. Si te interesa tener en una tabla a todos ellos para hacer tus propios menús, búsquedas o utilidades esta función te lo hace....

Buscar y documentar todos los elementos de Access

Sub ElementosMDBBuscar()
    Dim cnt As DAO.Container
    Dim doc As DAO.Document
    For Each cnt In CurrentDb.Containers
        For Each doc In cnt.Documents
            ElementosMDBDocumentar cnt, doc
        Next
    Next
    MsgBox "Documentación completada"
End Sub
Sub ElementosMDBDocumentar(cnt As DAO.Container, doc As DAO.Document)
    Dim strSQL As String
    Dim rstElementos As DAO.Recordset
    strSQL = "SELECT * FROM ElementosMDB WHERE Container='" & cnt.Name & "' AND Document='" & doc.Name & "'"
    Set rstElementos = CurrentDb.OpenRecordset(strSQL)
    If rstElementos.EOF Then
        rstElementos.AddNew
            rstElementos!Container = cnt.Name
            rstElementos!Document = doc.Name
        rstElementos.Update
    End If
    rstElementos.Close
End Sub

Todos los iconos de Access

Cómo ver todos los iconos de Microsoft Access...

Con esta secuencia creamos una barras de menús para ver todos los iconos que lleva incorporados Access y desde personalizar podemos copiar y pegar. Comprobado en Access 2000 y 2003

Sub EnumerarIconosAccess()
    Dim cb  As CommandBar
    Dim cb1 As CommandBar
    Dim cbc As CommandBarControl
    Dim cbc1 As CommandBarControl
    Dim cbc2 As CommandBarButton
    Dim cbb As CommandBarButton
    Dim cbx As CommandBarComboBox
    Dim cbp As CommandBarPopup
    Dim cbp1 As CommandBarPopup
    Dim ind1 As Integer
    Dim ind2 As Integer
    For ind1 = 1 To 4
        Set cb = Application.CommandBars.Add("Botones" + Str(ind1))
        For ind2 = ((ind1 - 1) * 1000) + 1 To (ind1 * 1000)
            Set cbc2 = cb.Controls.Add(msoControlButton)
            cbc2.Style = msoButtonIcon
            cbc2.FaceId = ind2
            cbc2.Caption = ind2
            cbc2.Tag = ind2
        Next ind2
    Next ind1
    MsgBox "Barra Creada"
End Sub

DAO

Documentar elementos de Microsoft Access -

Documentar elementos de Microsoft Access

Buscar y documentar todos los elementos de Access

Sub ElementosMDBBuscar()
    Dim cnt As DAO.Container
    Dim doc As DAO.Document
    For Each cnt In CurrentDb.Containers
        For Each doc In cnt.Documents
            ElementosMDBDocumentar cnt, doc
        Next
    Next
    MsgBox "Documentación completada"
End Sub
Sub ElementosMDBDocumentar(cnt As DAO.Container, doc As DAO.Document)
    Dim strSQL As String
    Dim rstElementos As DAO.Recordset
    strSQL = "SELECT * FROM ElementosMDB WHERE Container='" & cnt.Name & "' AND Document='" & doc.Name & "'"
    Set rstElementos = CurrentDb.OpenRecordset(strSQL)
    If rstElementos.EOF Then
        rstElementos.AddNew
            rstElementos!Container = cnt.Name
            rstElementos!Document = doc.Name
        rstElementos.Update
    End If
    rstElementos.Close
End Sub

Office

Excel desde Access - Permitir Macros -

Excel desde Access

Manejo básico de un libro de Excel desde una base de datos de Microsoft Access...

Es necesario antes marcar la referencia a la biblioteca de Excel.

Sub Ejemplo()
    On Error GoTo ErrorSub
    Dim app As Excel.Application
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim row As Excel.Range
    Dim cel As Excel.Range
    Set app = New Excel.Application
    Set wkb = app.Workbooks.Open("D:\alexborras\Downloads\Municipales_201905_1\04_201905_1.xlsx")
    ' Ver todas las hojas del libro abierto (el index empieza en 1)
    For Each wks In wkb.Sheets
        Debug.Print wks.Index & "." & wks.Name
    Next
    ' Seleccionar una hoja
    Set wks = wkb.Sheets(1)
    For Each row In wks.Rows
        Debug.Print wks.Name & ":" & wks.Rows.CountLarge
        For Each cel In row.Cells
            Debug.Print cel.Column & ":" & cel.Value
        Next
    Next
    Debug.Print wks.Name
    Set wks = Nothing
    Set wkb = Nothing
    Set app = Nothing
    Exit Sub
ErrorSub:
    MsgBox Err.Description
End Sub

Permitir Macros

Microsoft Access 2003 incorpora por defecto un sistema de bloqueo de macros que hace que programas como WinBol no se puedan abrir correctamente hasta que no se permita la ejecución de macros. Te explico como desactivarlo....

Para activar la ejecución de macros se deben seguir los siguientes pasos:

Abrir Microsoft Access 2003
Si da algún mensaje de que las expresiones están bloqueadas y si las queremos permitir, contestar que si.
Una vez abierto el Access 2003 ir a la opción Herramientas->Macro->Seguridad
Seleccionar el Nivel Bajo y pulsar Aceptar en todas las ventanas
Cerrar Access

La siguiente vez que se abra la aplicación ya no dará los mensajes de advertencia. Microsoft Access 2007 incorpora por defecto un sistema de bloqueo de macros que hace que programas como WinBol no se puedan abrir hasta que no se permita la ejecución de macros. Para activar la ejecución de macros se deben seguir los siguientes pasos:

Abrir Microsoft Access 2007
Hacer clic en el icono superior izquierdo y en la ventana de opciones que sale hacer clic en el botón Opciones de Access
En el menú izquierdo hacer clic en Centro de Confianza
En las opciones que salen hacer clic en el botón inferior derecho Configuración del Centro de Confianza
Hacer clic en la opción del menú izquierdo Configuración de Macros
Seleccionar la última opción: Habilitar todas las macros ...
Cerrar Access y abrir WinBol

Una vez hecho esto ya se podrá trabajar con normalidad con WinBol en Microsoft Access 2007

Recordset

Desplegable en Access combinando dos campos, uno de ellos nulo - ID de un nuevo registro - Obtener ID despues de Addnew -

Desplegable en Access combinando dos campos, uno de ellos nulo

Típico caso en Microsoft Access en el que tenemos que poner una desplegable para personas con el código oculto y visualizando nombre apellidos o apellidos, nombre el problema con el sistema normal es que si uno de los dos campos es nulo no se muestra nada....

La solución es poner esto en la columna de la consulta SQL de la que depende el campo de descripción:

Paciente: [apellidos]+SiInm(EsNulo([nombre propio]);"";", "+[nombre propio])

ID de un nuevo registro

Cómo saber el ID de un autonumérico recién creado en una tabla. También se busca cómo: Obtener el ultimo id del ultimo registro insertado y obtener ID de la última fila....

Si creamos un nuevo registro en una tabla cuyo índice es un campo autonumérico es posible que necesitemos saber la ID del registro recién creado. Para ello podemos utilizar las siguientes instrucciones:

' Cómo obtener el último valor autonumérico de una clave
rst.Move 0, rst.LastModified
lngID = rst!ID

Obtener ID despues de Addnew

Cómo obtener el último valor autonumérico después de un addnew en una tabla....

Si hacemos un Addnew de un registro mediante código VBA de Microsoft Access 2003 y la tabla tiene una clave formado por un ID autonumérico es posible que necesitemos saber cual es el valor que se le ha asignado a ese registro. Las instrucciones para saberlo son las siguientes (remarcadas en azul), suponemos que el campo autonumérico de la tabla se llama ID

Dim rstProyectosTareas As DAO.Recordset
Dim lngID As Long
Set rstProyectosTareas = CurrentDb.OpenRecordset("ProyectosTareas")
rstProyectosTareas.AddNew
rstProyectosTareas![...] = ...
rstProyectosTareas![...] = ...
rstProyectosTareas.Update
' Como obtener el último valor autonumérico de una clave
rstProyectosTareas.Move 0, rstProyectosTareas.LastModified
lngID = rstProyectosTareas!ID
' Fin de como obtener
rstProyectosTareas.Close

SQL

SQL con apóstrofe - Uso de Apóstrofe -

SQL con apóstrofe

Cuando la sentencia SQL incluye apóstrofes tendremos problemas si no hacemos de una forma especial. Te lo enseño en este ejemplo....

Por ejemplo con la palabra Ho'oponopono

strSQL = "SELECT * FROM Keywords WHERE KeywordTXT=" & """" & Texto & """"

Uso de Apóstrofe

Si se quiere utilizar variables en consultas SQL que tienen un apóstrofe, al crear la sentencia utiliza comillas dobles dos veces, por ejemplo:...

Variable = "D' Amato" SQL = "SELECT * FROM tabla1 WHERE campo1 = """" Variable """"

Strings

Contar un carácter - Eliminar caracteres especiales de una cadena - Equivalencias PHP - Visual Basic - Extensión de un archivo - Extraer el dominio de una URL - Extraer emails de un texto - Len: Contar caracteres en una cadena - Limpiar etiquetas - Quitar el último carácter de una cadena - Reemplazar string en una cadena - Rellenar con ceros a la izquierda - Split - Subcadena por delimitadores -

Contar un carácter

Si quieres contar las veces que aparece un determinado carácter en una cadena o string, puedes utilizar esta función o el código de la misma. También se conoce como "ocurrencias" de un carácter. ...

Función para contar caracteres en una cadena

Function absCharCount(Text As String, Char As String) As Long
    Dim lngCount As Long
    Dim strVar() As String
    strVar = Split(Text, Char)
    absCharCount = UBound(strVar)
End Function

Fecha: 30-08-2023

Eliminar caracteres especiales de una cadena

Función que elimina todos los caracteres especiales de una cadena....

Cómo se puede ver es fácilmente ampliable.

Public Function EliminarCaracteresEspeciales(Texto As String) As String
    Texto = Replace(Texto, "ñ", "N")
    Texto = Replace(Texto, "ñ", "ny")
    Texto = Replace(Texto, "Ñ", "NY")
    Texto = Replace(Texto, "á", "a")
    Texto = Replace(Texto, "é", "e;")
    Texto = Replace(Texto, "í", "i")
    Texto = Replace(Texto, "ó", "o")
    Texto = Replace(Texto, "ú", "u")
    Texto = Replace(Texto, "à", "a")
    Texto = Replace(Texto, "è", "e;")
    Texto = Replace(Texto, "ì", "i")
    Texto = Replace(Texto, "ò", "o")
    Texto = Replace(Texto, "ù", "u")
    Texto = Replace(Texto, "Á", "A")
    Texto = Replace(Texto, "É", "E;")
    Texto = Replace(Texto, "Í", "I")
    Texto = Replace(Texto, "Ó", "O")
    Texto = Replace(Texto, "Ú", "U")
' Dieresis ä
    Texto = Replace(Texto, "ä", "a")
    Texto = Replace(Texto, "ë", "e;")
    Texto = Replace(Texto, "ï", "i")
    Texto = Replace(Texto, "ö", "o")
    Texto = Replace(Texto, "ü", "u")
    Texto = Replace(Texto, "Ä", "A")
    Texto = Replace(Texto, "Ë", "E;")
    Texto = Replace(Texto, "Ï", "I")
    Texto = Replace(Texto, "Ö", "O")
    Texto = Replace(Texto, "Ü", "U")
' Otros
    Texto = Replace(Texto, "&", "And")
    Texto = Replace(Texto, "ã", "a")
    Texto = Replace(Texto, "ç", "c")
    Texto = Replace(Texto, "Ç", "c")
    Texto = Replace(Texto, "´", " ")
    Texto = Replace(Texto, "’", " ")
    Texto = Replace(Texto, "'", " ")
    Texto = Replace(Texto, "ª", " ")
    Texto = Replace(Texto, "º", " ")
    Texto = Replace(Texto, """", " ")
    EliminarCaracteresEspeciales = Texto
End Function

Equivalencias PHP - Visual Basic

Un par de ejemplos de algunas equivalencias entre ambos lenguajes para tratar cadenas....

ACCESS	PHP
Obtener un fragmento de una Cadena (String)
Dim MyString As String MyString = "This is string example" MsgBox Mid(MyString, 5, 10)	$MyString = "This is string example"; echo substr($MyString,5,10);
Fragmentar una cadena en función de un carácter
Dim MyString As String MyString = "Data1;Data2" matString = Split(MyString,"") debug.print matString(0) ' da Data1 debug.print matString(1) ' da Data2	$MyString = "Data1;Data2"; $matString = explode(";",$MyString); echo matString[0] // da Data1 echo matString[1] // da Data2

Extensión de un archivo

Como saber la extensión de un archivo....

Esta instrucción tiene en cuenta que en el nombre del archivo pueda haber mas de un punto y que la extensión pueda ser un numero variable de caracteres. Se facilita en formato de Function pero puede ser convertida a una sola instrucción

Function ExtensionArchivo(Archivo As String, Optional Caracter As String = ".") As String
    On Error Resume Next
    ExtensionArchivo = Right(Archivo, Len(Archivo) - InStrRev(Archivo, Caracter))
End Function

Extraer el dominio de una URL

...

Public Function ExtraerURL(URL As String) As String
    'quita la última barra
    If Right(URL, 1) = "/" Then
        ExtraerURL = Mid(URL, 1, Len(URL) - 1)
      Else
        ExtraerURL = URL
    End If
    ExtraerURL = Replace(ExtraerURL, "https://", "")
    ExtraerURL = Replace(ExtraerURL, "http://", "")
End Function

Un ejemplo de uso sería

debug.print ExtraerURL("https://alexborras.com/")[/vb]

Devuelve el valor www.alexborras.com Jugando con las sustituciones también podríamos eliminar las primeras www si queremos solo el dominio raíz.

Extraer emails de un texto

Con esta función puedes extraer cuentas de correo electrónico de un texto o campo tipo string....

Esta es una función que suelo utilizar para extraer emails de texto. Es la versión simplificada para encontrar un solo email ya que con una modificación en el Gosub puede capturar un número indeterminado de emails y almacenarlos en una colección de objetos. La función también sirve de ejemplo para la utilización de varias sentencias de manejo de strings en Visual Basic: Instr, Len, Mid y Asc

Public Function CapturarEmailTexto(Texto) As String
    Dim indPos As Long
    Dim indDesde As Long
    Dim indHasta As Long
    Dim strEmail As String
    Dim strInt   As String
    On Error GoTo ErrorSub
    CapturarEmailTexto = ""
    strEmail = ""
    If InStr(1, Texto, "@") = 0 Then Exit Function
    For indPos = 1 To Len(Texto)
        If Mid(Texto, indPos, 1) = "@" Then
            GoSub Captura
            Exit For
        End If
    Next
    CapturarEmailTexto = strEmail
    Exit Function
Captura:
    indDesde = 0
    indHasta = 0
' Buscar Inicio de Email
    For indDesde = indPos - 1 To 0 Step -1
        If indDesde = 0 Then Exit For
        strInt = Mid(Texto, indDesde, 1)
        If strInt = " " Then Exit For
        If strInt = ":" Then Exit For
        If strInt = "(" Then Exit For
        If strInt = ")" Then Exit For
        If strInt = "[" Then Exit For
        If strInt = "]" Then Exit For
        If strInt = "<" Then Exit For If strInt = ">" Then Exit For
        If strInt = """" Then Exit For
        If strInt = "'" Then Exit For
        If Asc(strInt) = 13 Then Exit For ' Control de Return
        If Asc(strInt) = 10 Then Exit For ' Control de Return
    Next
' Buscar Final de Email
    For indHasta = indPos + 1 To Len(Texto)
        strInt = Mid(Texto, indHasta, 1)
        If strInt = " " Then Exit For
        If strInt = ":" Then Exit For
        If strInt = "(" Then Exit For
        If strInt = ")" Then Exit For
        If strInt = "[" Then Exit For
        If strInt = "]" Then Exit For
        If strInt = "<" Then Exit For If strInt = ">" Then Exit For
        If strInt = """" Then Exit For
        If strInt = "'" Then Exit For
        If Asc(strInt) = 13 Then Exit For ' Control de Return
        If Asc(strInt) = 10 Then Exit For ' Control de Return
    Next
' Determinar Mail
    strEmail = Mid(Texto, indDesde + 1, indHasta - indDesde - 1)
' Eliminar Caracteres Finales incorrectos
    If Right(strEmail, 1) = "." Then strEmail = Mid(strEmail, 1, Len(strEmail) - 1)
    If Right(strEmail, 1) = "," Then strEmail = Mid(strEmail, 1, Len(strEmail) - 1)
    Return
ErrorSub:
    MsgBox Err.Number & ": " & Err.Description
End Function

Len: Contar caracteres en una cadena

La función Len que permite contar las apariciones de una cadena dentro de otra....

Esta es una función manual que puede permitir manipular los caracteres de la cadena

Public Function CuentaPalabras(Texto As String, Palabra As String) As Long
    Dim wptr As Long
    Dim count As Long
    wptr = InStr(Texto, Palabra)
    Do Until wptr = 0
        count = count + 1
        wptr = InStr(wptr + 1, Texto, Palabra)
    Loop
    CuentaPalabras = count
End Function

Limpiar etiquetas

Esta función permite limpiar etiquetas de párrafos (p) y listas (ul y li) de una manera sencilla. Es especialmente útil cuando se copia texto desde Word o Google Docs a una página web....


' Eliminar párrafos
    strCleaned = CleanLabelsStyle(strCleaned, "p")
    strCleaned = CleanLabelsStyle(strCleaned, "li")
    strCleaned = CleanLabelsStyle(strCleaned, "ul")
    txtCleaned = strCleaned
End Sub
Function CleanLabelsStyle(HTML As String, LabelsStyle As String) As String
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    ' Pattern to match the  tags with parameters
    regex.Pattern = "]*>"
    regex.Global = True

    ' Replace the matched patterns with 

    CleanLabelsStyle = regex.Replace(HTML, "")

    ' Optional: Ensuring all  tags are correct (although it should be)
    ' regex.Pattern = ""
    ' CleanParagraphs = regex.Replace(CleanParagraphs, "")

    Set regex = Nothing
End Function

Quitar el último carácter de una cadena

Cómo eliminar el último carácter de una cadena. ...

dim Texto as string
Texto = "Hola1";
Texto = Left(Texto, Len(Texto) - 1)

La variable Texto valdrá "Hola"

Reemplazar string en una cadena

La función Replace de Visual Basic reemplaza un string formado por uno o varios caracteres en una cadena por otro string formado por uno o varios caracteres. Su sintaxis es simple no necesita ejemplos, con la ayuda es suficiente.

Rellenar con ceros a la izquierda

Para rellenar un número con ceros no significativos a la izquierda se puede usar la instrucción Format. Por ejemplo, queremos que en un informe se vea 001 para un campo numérico que tiene el valor 1
Ejemplo para campo de formulario: =Format([NumeroFactura];"000")
Ejemplo para código Visual Basic 6: txtNumeroFactura = Format(NumeroFactura,"000")
Para otros relleno solo hace falta variar el número de ceros.

Split

Separa un string en varias cadenas dentro de una matriz en función del carácter definido. ...

Ejemplo de la función Split:

Dim matStrings() As String
txtstrings = "Uno,Dos,Tres"
matStrings = Split(txtStrings, ",")

Obtenemos una matriz de Strings con cada uno de los elementos: matstrings(1) = "Uno" matstrings(2) = "Dos" matstrings(3) = "Tres"

Subcadena por delimitadores

Obtener una subcadena (substring) en función de dos delimitadores iguales o diferentes. Se puede utilizar para obtener texto entre paréntesis o guiones, por ejemplo....

Función para obtener una Subcadena por delimitadores

Function absSubStringDelimiter(Text As String, Char1 As String, Char2 As String) As String
    Dim pos1 As Integer
    Dim pos2 As Integer
    pos1 = InStr(1, Text, Char1)
    pos2 = InStr(1, Text, Char2)
    If pos1 > 0 And pos2 > 0 Then
        If pos2 > pos1 Then
            absSubStringDelimiter = Trim(Mid(Text, pos1 + 1, (pos2 - pos1 - 1)))
        End If
    End If
End Function

Fecha: 30-08-2023

email

Extraer emails de un texto -

Extraer emails de un texto

Con esta función puedes extraer cuentas de correo electrónico de un texto o campo tipo string....

Public Function CapturarEmailTexto(Texto) As String
    Dim indPos As Long
    Dim indDesde As Long
    Dim indHasta As Long
    Dim strEmail As String
    Dim strInt   As String
    On Error GoTo ErrorSub
    CapturarEmailTexto = ""
    strEmail = ""
    If InStr(1, Texto, "@") = 0 Then Exit Function
    For indPos = 1 To Len(Texto)
        If Mid(Texto, indPos, 1) = "@" Then
            GoSub Captura
            Exit For
        End If
    Next
    CapturarEmailTexto = strEmail
    Exit Function
Captura:
    indDesde = 0
    indHasta = 0
' Buscar Inicio de Email
    For indDesde = indPos - 1 To 0 Step -1
        If indDesde = 0 Then Exit For
        strInt = Mid(Texto, indDesde, 1)
        If strInt = " " Then Exit For
        If strInt = ":" Then Exit For
        If strInt = "(" Then Exit For
        If strInt = ")" Then Exit For
        If strInt = "[" Then Exit For
        If strInt = "]" Then Exit For
        If strInt = "<" Then Exit For If strInt = ">" Then Exit For
        If strInt = """" Then Exit For
        If strInt = "'" Then Exit For
        If Asc(strInt) = 13 Then Exit For ' Control de Return
        If Asc(strInt) = 10 Then Exit For ' Control de Return
    Next
' Buscar Final de Email
    For indHasta = indPos + 1 To Len(Texto)
        strInt = Mid(Texto, indHasta, 1)
        If strInt = " " Then Exit For
        If strInt = ":" Then Exit For
        If strInt = "(" Then Exit For
        If strInt = ")" Then Exit For
        If strInt = "[" Then Exit For
        If strInt = "]" Then Exit For
        If strInt = "<" Then Exit For If strInt = ">" Then Exit For
        If strInt = """" Then Exit For
        If strInt = "'" Then Exit For
        If Asc(strInt) = 13 Then Exit For ' Control de Return
        If Asc(strInt) = 10 Then Exit For ' Control de Return
    Next
' Determinar Mail
    strEmail = Mid(Texto, indDesde + 1, indHasta - indDesde - 1)
' Eliminar Caracteres Finales incorrectos
    If Right(strEmail, 1) = "." Then strEmail = Mid(strEmail, 1, Len(strEmail) - 1)
    If Right(strEmail, 1) = "," Then strEmail = Mid(strEmail, 1, Len(strEmail) - 1)
    Return
ErrorSub:
    MsgBox Err.Number & ": " & Err.Description
End Function

System

Clipboard - Cómo obtener el nombre del ordenador o PC - Leer archivos grandes con VBA - Seleccionar un archivo - Unir archivos de texto -

Clipboard

Código para una función que permite copiar texto al clipboard...

Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, _
    ByVal dwBytes As LongPtr) As LongPtr
  Private Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
  Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
  Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
  Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
    ByVal lpString2 As Any) As LongPtr
  Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As LongPtr, _
    ByVal hMem As LongPtr) As LongPtr
Const GHND = &H42
Const CF_TEXT = 1
Const MAXSIZE = 4096
Function ClipBoard_SetData(MyString As String)
'PURPOSE: API function to copy text to clipboard
'SOURCE: www.msdn.microsoft.com/en-us/library/office/ff192913.aspx

#If VBA7 Then
  Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr
  Dim hClipMemory As LongPtr, x As LongPtr
#Else
  Dim hGlobalMemory As Long, lpGlobalMemory As Long
  Dim hClipMemory As Long, x As Long
#End If

'Allocate moveable global memory
  hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

'Lock the block to get a far pointer to this memory.
  lpGlobalMemory = GlobalLock(hGlobalMemory)

'Copy the string to this global memory.
  lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

'Unlock the memory.
  If GlobalUnlock(hGlobalMemory) <> 0 Then
    MsgBox "Could not unlock memory location. Copy aborted."
    GoTo OutOfHere2
  End If

'Open the Clipboard to copy data to.
  If OpenClipboard(0&) = 0 Then
    MsgBox "Could not open the Clipboard. Copy aborted."
    Exit Function
  End If

'Clear the Clipboard.
  x = EmptyClipboard()

'Copy the data to the Clipboard.
  hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:
  If CloseClipboard() = 0 Then
    MsgBox "Could not close Clipboard."
  End If

End Function

Sub CopyTextToClipboard()
'PURPOSE: Copy a given text to the clipboard (using Windows API)
'SOURCE: www.TheSpreadsheetGuru.com
'NOTES: Must have above API declaration and ClipBoard_SetData function in your code

Dim txt As String

'Put some text inside a string variable
  txt = "This was copied to the clipboard using VBA!"

'Place text into the Clipboard
   ClipBoard_SetData txt

'Notify User
  MsgBox "There is now text copied to your clipboard!", vbInformation

End Sub

Cómo obtener el nombre del ordenador o PC

Permite saber el nombre del PC donde está funcionando la base de datos Access...

Public Function GetComputerName() As String
   Dim sResult As String * 255
   GetComputerNameA sResult, 255
   GetComputerName = Left$(sResult, InStr(sResult, Chr$(0)) - 1)
End Function

Leer archivos grandes con VBA

Un ejemplo de lectura de archivos grandes sin que se bloquee el PC por falta de recursos. Probado con un archivo de 4 GB...

Rutina de lectura:

Public Sub ImportV2()
    Dim strReg As String
    Dim strFile As String
    Dim fso As FileSystemObject
    Dim fil As Object
    strFile = "C:\Users\username\Downloads\file.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fil = fso.OpenTextFile(strFile, 1)
    Do Until fil.AtEndOfStream
        strReg = fil.ReadLine
    Loop
    fil.Close
End Sub

Seleccionar un archivo

Cómo seleccionar un archivo desde un formulario de Microsoft Access usando VBA....

Recordar que se requiere una referencia a la librería: Microsoft Office 16.0 Object Library.

Public Function SelectFileSample() As String
   ' Requires reference to Microsoft Office 16.0 Object Library.
   Dim fDialog As Office.FileDialog
   Dim varFile As Variant
   Dim fso As FileSystemObject
   ' Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
        '.InitialFileName = strCarpeta ' Default folder
        ' Allow user to make multiple selections in dialog box
        .AllowMultiSelect = False
        ' Set the title of the dialog box.
        .Title = "Seleccionar un fichero"
        ' Clear out the current filters, and add our own.
        .Filters.Clear
        ' Sample for filters
        '.Filters.Add "Image JPG", "*.JPG"
        '.Filters.Add "Image PNG", "*.PNG"
        .Filters.Add "Todos los archivos", "*.*"
        ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
        If .Show = True Then
           'Loop through each file selected and add it to our list box.
           For Each varFile In .SelectedItems
             'Me.FileList.AddItem varFile
              SelectFileSample = varFile
           Next
        Else
           MsgBox "No saleccionado ningún fichero", vbInformation, "Select File"
        End If
   End With
End Function

Unir archivos de texto

Bucle para unir ficheros de texto que están en una misma carpeta, en este caso .csv en uno solo....

    Dim rutaCarpeta As String
    Dim archivo As String
    Dim nombreArchivoUnido As String
    Dim textoArchivo As String
    Dim primeraLinea As Boolean
    Dim numArchivo As Integer
    Dim fso As Object, ts As Object, tsUnion As Object

    rutaCarpeta = "C:\TuCarpeta\" ' Modifica con la ruta de tu carpeta
    nombreArchivoUnido = rutaCarpeta & "ArchivoUnido.csv" ' Nombre del archivo final

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tsUnion = fso.CreateTextFile(nombreArchivoUnido, True)

    archivo = Dir(rutaCarpeta & "*.csv")
    primeraLinea = True

    Do While archivo <> ""
        ' Evita leer el archivo unido si ya existe en la carpeta
        If archivo <> "ArchivoUnido.csv" Then
            numArchivo = numArchivo + 1
            Set ts = fso.OpenTextFile(rutaCarpeta & archivo, ForReading)

            ' Omitir la primera línea del archivo si no es el primero (suponiendo que es el encabezado)
            If Not primeraLinea Then ts.ReadLine

            ' Leer el contenido del archivo y escribirlo en el archivo unido
            Do While ts.AtEndOfStream <> True
                textoArchivo = ts.ReadLine
                tsUnion.WriteLine textoArchivo
            Loop

            ts.Close
            primeraLinea = False
        End If

        archivo = Dir() ' Siguiente archivo
    Loop

    tsUnion.Close
    Set ts = Nothing
    Set tsUnion = Nothing
    Set fso = Nothing

    MsgBox numArchivo & " archivos han sido unidos en " & nombreArchivoUnido, vbInformation
End Sub

Este código realiza las siguientes tareas:

Establece la ruta de la carpeta donde se encuentran los archivos CSV y el nombre del archivo CSV unido final.
Utiliza un objeto FileSystemObject para trabajar con archivos y carpetas.
Abre cada archivo CSV en la carpeta, omite la primera línea para todos los archivos excepto el primero (asumiendo que es un encabezado) y escribe su contenido en un nuevo archivo CSV.
Continúa este proceso para todos los archivos CSV en la carpeta.
Muestra un mensaje al finalizar, indicando cuántos archivos han sido unidos.

Teoría

Convención Reddick para nombres de elementos -

Convención Reddick para nombres de elementos

Son un conjunto de normas que te serán de mucha utilidad a la hora de definir todos los elementos de una aplicación desarrollada con Microsoft Access. Ver fuente

URL

Extraer el dominio de una URL - Leer el contenido de una URL con Visual Basic - Rellenar un campo Hyperlink - Scraping con VBA -

Extraer el dominio de una URL

...

Public Function ExtraerURL(URL As String) As String
    'quita la última barra
    If Right(URL, 1) = "/" Then
        ExtraerURL = Mid(URL, 1, Len(URL) - 1)
      Else
        ExtraerURL = URL
    End If
    ExtraerURL = Replace(ExtraerURL, "https://", "")
    ExtraerURL = Replace(ExtraerURL, "http://", "")
End Function

Un ejemplo de uso sería

debug.print ExtraerURL("https://alexborras.com/")[/vb]

Devuelve el valor www.alexborras.com Jugando con las sustituciones también podríamos eliminar las primeras www si queremos solo el dominio raíz.

Leer el contenido de una URL con Visual Basic

Podemos acceder al contenido de una dirección URL usando el objeto Document....

Podemos acceder al contenido de una dirección URL con las siguientes instrucciones. Pongo dos ejemplos, uno donde se obtiene el título de la página con una propiedad directa del objeto y otra donde se captura el contenido HTML completo del cuerpo de la URL usando el objeto Document.

Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
    .Visible = False
    .Navigate URLtxt
    Do While .ReadyState <> 4: DoEvents: Loop
    Debug.Print = .LocationName ' Título de la página
    Debug.Print = .Document.Body.InnerHtml ' Contenido HTML de la página
    .Quit
End With
Set objIE = Nothing

Rellenar un campo Hyperlink

Para rellenar un campo del tipo Hyperlink cuando hacemos un add o edit de un resitro se hace de la siguiente forma: rst!CampoHyperlink = "Texto#URL#"

Scraping con VBA

Cómo obtener el código HTML de una URL mediante VBA. ...

En noviembre de 2021 me dejó de funcionar la lectura del HTML mediante el uso de CreateObject("InternetExplorer.Application"). Windows siempre abre ya Microsoft Edge por defecto y el objeto llamado no tiene las propiedades del InternetExplorer.Application. La alternativa es usar la biblioteca MSXML2 que podemos añadir a nuestro VBA como referencia. Os dejo un ejemplo del uso que le estoy dando, el contenido del HTML en formato texto está en la propiedad responseText.

Dim oXMLHTTP As Object
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
With oXMLHTTP
.Open "GET", URLtxt, False
.send
Titulo = absTags(.responseText, "<H1", "</H1>")
End With
Set oXMLHTTP = Nothing

IE Object

Leer el contenido de una URL con Visual Basic -

Leer el contenido de una URL con Visual Basic

Podemos acceder al contenido de una dirección URL usando el objeto Document....

Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
    .Visible = False
    .Navigate URLtxt
    Do While .ReadyState <> 4: DoEvents: Loop
    Debug.Print = .LocationName ' Título de la página
    Debug.Print = .Document.Body.InnerHtml ' Contenido HTML de la página
    .Quit
End With
Set objIE = Nothing

Desarrollado con el Plugin Diccionario de WordPress

Descargas de ejemplos de Microsoft Access

Historia Clínica

Es una base de datos sencilla para gestionar la historia clínica de una persona. Encontraras conceptos básicos como formularios, botones e informes. No se usan módulos VBA excepto el de los forms. Para nivel básico. Descargar HistoriaClinica en formato ZIP.

Acerca de Microsoft Access

Microsoft Access, una parte integral de la suite de Microsoft Office, es un sistema de gestión de bases de datos introducido por primera vez en 1992. Diseñado para usuarios de Windows, Access se creó para satisfacer la necesidad de un programa que pudiera manejar la gestión de datos y el desarrollo de aplicaciones de una manera más accesible que los sistemas de bases de datos más complejos y costosos de la época.

Desde su lanzamiento, Access se destacó por permitir a los usuarios no solo almacenar y gestionar grandes cantidades de información de manera eficiente, sino también por facilitar la creación de interfaces de usuario personalizadas y aplicaciones de bases de datos a través de su entorno de desarrollo integrado. Esto lo hizo especialmente popular entre las pequeñas y medianas empresas, así como entre los departamentos dentro de organizaciones más grandes, que necesitaban soluciones de bases de datos personalizadas sin la inversión significativa que requerían otros sistemas.

A lo largo de los años, Microsoft ha lanzado varias versiones de Access, cada una añadiendo nuevas funcionalidades, mejorando la interfaz de usuario y aumentando la integración con otros productos de Microsoft Office. Estas mejoras han permitido a Access mantenerse relevante en un mercado en constante cambio, adaptándose a las necesidades de los usuarios modernos y a las tendencias tecnológicas.

A pesar de enfrentar la competencia de otras soluciones de bases de datos y de la creciente popularidad de las soluciones basadas en la nube, Microsoft Access ha mantenido un núcleo leal de usuarios. Su capacidad para combinar una gestión de datos robusta con herramientas de desarrollo de aplicaciones relativamente fáciles de usar ha asegurado su lugar como una herramienta valiosa para la gestión de datos personal y empresarial.

Con el paso del tiempo, Microsoft Access ha evolucionado desde sus inicios como una herramienta de base de datos para pequeñas empresas hasta convertirse en una solución de gestión de datos completa, demostrando su durabilidad y adaptabilidad en el ámbito tecnológico.

César Ramírez

20 febrero, 2023 a las 15:40

Saludos.
¿Como hacer un instalador de programas ? Algo que grabe algunos archivos predeterminados en algún lugar del disco duro de manera discreta.

Alex Borrás

24 febrero, 2023 a las 17:50

Para aplicaciones con Access y VBA usé durante muchos años Wise Installation System y me iba perfecto. Aún se puede descargar de Softonic: WISE Installation System para Windows

davier

14 noviembre, 2023 a las 04:52

s@lu2
tengo una bd de un Almacen , en un formulario de salida de productos quiciera poder limitar la cantidad a «salir» de acuerdo al inventario existente para cada articulo.

gracias

antonia

8 febrero, 2024 a las 23:57

hola no soy experta ni mucho menos, hice un formulario que manda llamar información de una base vinculada, pero no me extrae varios campos, no se por que razón, haber si alguién pueda orientarme gracias.
On Error GoTo Button_TratamientoErrores
‘mySql = «SELECT calendariobpm .institucio, calendariobpm .examen, calendariobpm .fec_ini, calendariobpm .aplicados, calendariobpm .registrado, calendariobpm .for_env, calendariobpm .desc_cal, calendariobpm .ent_arccal, curcalenbpm.requerimie FROM calendariobpm INNER JOIN curcalenbpm ON calendariobpm.num_aplic=curcalenbpm.num_aplic WHERE num_aplic = ‘» & Me.Aplicación & «‘»
On Error GoTo Button_TratamientoErrores
mySql = «SELECT institucio, examen, fec_ini, aplicados, registrado, for_env, desc_cal, ent_arccal, desc_exa, Requerimie FROM curcalenbpm»
mySql = mySql & » WHERE num_aplic = ‘» & Me.Aplicación & «‘»
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(mySql, dbOpenSnapshot)

Me.Institución.Value = rst.Fields(0)
Me.Examen.Value = rst.Fields(1)
Me.Fecha_de_aplicación.Value = rst.Fields(2)
Me.Aplicados.Value = rst.Fields(3)
Me.Registrados.Value = rst.Fields(4)
Me.Entrega_resultados.Value = rst.Fields(5)
Me.des_exa.Value = rst.Fields(6)
Me.Requerimientos.Value = rst.Fields(7)

rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing
nota los campos que si jala son
Me.Institución.Value = rst.Fields(0)
Me.Examen.Value = rst.Fields(1)
Me.Fecha_de_aplicación.Value = rst.Fields(2)
y los que no acepta son:
Me.Aplicados.Value = rst.Fields(3)
Me.Registrados.Value = rst.Fields(4)
Me.Entrega_resultados.Value = rst.Fields(5)
Me.des_exa.Value = rst.Fields(6)
Me.Requerimientos.Value = rst.Fields(7)

16 febrero, 2024 a las 13:43

Si pudieras enviar un mdb de ejemplo solo con un formulario, la tabla con datos de ejemplo y el código te lo puedo mirar

16 febrero, 2024 a las 13:46

Eso es bastante sencillo de hacer, pero se debería usar código VBA en el momento de validar los datos.

Viviana velez

20 abril, 2024 a las 17:00

Buen día me puedes ayudar. Tengo una base de datos con formularios e informes y necesito que los formularios los puedan leer también en italiano. Pues se trabaja en esos dos idiomas.

7 mayo, 2024 a las 18:43

Creo que ya hablamos este tema por email respecto al modelo de traducción en Access, hay un artículo temático en mi blog sobre este tema.

PEDRO

20 junio, 2024 a las 04:18

necesito ayuda…
Como se hace para que todas las letras de un campo SIEMPRE sean mayúsculas…

17 julio, 2024 a las 10:27

Para convertir un string a mayúsculas en VBA, puedes utilizar la función UCase. Esta función toma un string como argumento y devuelve el mismo string pero con todas las letras convertidas a mayúsculas.

Aquí tienes un ejemplo de cómo usar UCase en VBA:
Sub ConvertirAMayusculas() Dim textoOriginal As String Dim textoEnMayusculas As String

' Asigna un valor al string original
textoOriginal = "Hola, mundo!"

' Convierte el string a mayúsculas
textoEnMayusculas = UCase(textoOriginal)

' Muestra el resultado en un mensaje
MsgBox textoEnMayusculas
End Sub