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) - DAO(1) - Excel(1) - Fechas(4) - FileSystem(3) - Forms(8) - IE Object(1) - Informes(1) - MDB(3) - Office(2) - Recordset(3) - SQL(2) - Strings(13) - System(5) - TableDefs(2) - Teoría(1) - URL(4) - email(1) -Bucles
Comandos de menú de Access - DoEvents en bucles - Listar los campos de una tabla -Comandos de menú de AccessCó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 buclesMantener 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 LoopSin 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 tablaUn 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
|
DAO
Documentar elementos de Microsoft Access -Excel
Buscar valor en celda -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 -FileSystem
Leer archivos grandes con VBA - Seleccionar un archivo - Unir archivos de texto -Leer archivos grandes con VBAUn 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 archivoCó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 textoBucle 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:
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 -IE Object
Leer el contenido de una URL con Visual Basic -Informes
Campos calculados en informes -MDB
Convertir un MDB de Access a Texto - Documentar elementos de Microsoft Access - Todos los iconos de Access -Convertir un MDB de Access a TextoEsta 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 AccessLos 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 AccessCó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
|
Office
Excel desde Access - Permitir Macros -Excel desde AccessManejo 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 MacrosMicrosoft 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:
|
Recordset
Desplegable en Access combinando dos campos, uno de ellos nulo - ID de un nuevo registro - Obtener ID despues de Addnew -SQL
SQL con apóstrofe - Uso de Apóstrofe -SQL con apóstrofeCuando 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óstrofeSi 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 -System
Clipboard - Cómo obtener el nombre del ordenador o PC - Leer archivos grandes con VBA - Seleccionar un archivo - Unir archivos de texto -ClipboardCó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 PCPermite 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 VBAUn 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 archivoCó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 textoBucle 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:
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. |
TableDefs
Listar los campos de una tabla - Reconectar tablas vinculadas -Listar los campos de una tablaUn 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 vinculadasUna 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 |
Teoría
Convención Reddick para nombres de elementos -Convención Reddick para nombres de elementosSon 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. |
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 BasicPodemos 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 HyperlinkPara 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 VBACó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
|
Extraer emails de un textoCon 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
|
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.
Saludos.
¿Como hacer un instalador de programas ? Algo que grabe algunos archivos predeterminados en algún lugar del disco duro de manera discreta.
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
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
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)
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
Eso es bastante sencillo de hacer, pero se debería usar código VBA en el momento de validar los datos.
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.
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.
necesito ayuda…
Como se hace para que todas las letras de un campo SIEMPRE sean mayúsculas…
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