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.
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
-Todos- Bucles (3) TableDefs (2) Excel (1) Fechas (4) FileSystem (2) Forms (6) Informes (1) MDB (3) DAO (1) Office (2) Recordset (3) SQL (2) Strings (12) email (1) System (4) Teoría (1) URL (4) IE Object (1)Alter Table - Buscar un registro en Access 2003 - Buscar valor en celda - Campos calculados en informes - Clipboard - Comandos de menú de Access - Como crear un hipervínculo en un formulario - Cómo obtener el nombre del ordenador o PC - Contar un carácter - Convención Reddick para nombres de elementos - Convertir minutos a formato Fecha (Date) - Convertir un MDB de Access a Texto - Desplegable en Access combinando dos campos, uno de ellos nulo - Documentar elementos de Microsoft Access - DoEvents en bucles - Eliminar caracteres especiales de una cadena - Equivalencias PHP - Visual Basic - Excel desde Access - Extensión de un archivo - Extraer el dominio de una URL - Extraer emails de un texto - Filtro y orden de registros de un formulario - ID de un nuevo registro - Ir al final de un campo - Leer archivos grandes con VBA - Leer el contenido de una URL con Visual Basic - Len: Contar caracteres en una cadena - Listar los campos de una tabla - Microsoft Flexgrid en Access 365 con Windows 10 - Minutos a formato HH:NN string - Obtener ID despues de Addnew - Permitir Macros - Primer y último día de la semana - Propiedad ControlSource en un Formulario Access - Quitar el último carácter de una cadena - Reconectar tablas vinculadas - Reemplazar string en una cadena - Rellenar con ceros a la izquierda - Rellenar un campo Hyperlink - Scraping con VBA - Seleccionar un archivo - Split - SQL con apóstrofe - Subcadena por delimitadores - Todos los iconos de Access - Uso de Apóstrofe - Vibración de letras en formularios de Microsoft Access -
Alter TableLa instrucción ALTER TABLE en SQL es una operación fundamental que se utiliza para modificar la estructura de una tabla existente en una base de datos. Esta instrucción es versátil y se puede emplear para realizar una variedad de cambios sin necesidad de eliminar y recrear la tabla, lo que ayuda a mantener la integridad de los datos existentes. Ejemplos de Alter Table con ADD Column, CONSTRAINT , CREATE TABLE, etc. para Microsoft Access....-- CAG ALTER TABLE CAGT0001 ADD COLUMN Tratamiento TEXT (12) ALTER TABLE CAGT0001 ADD COLUMN SerieFactura TEXT (2) ALTER TABLE CAGT0001 ADD COLUMN NumeroFactura Long -- CAGT0002: LLamadas Counter es Autonumerico CREATE TABLE CAGT0002 ([LLamada] Counter, CONSTRAINT CAGT0002_PK Primary Key ([LLamada])) ALTER TABLE CAGT0002 ADD COLUMN [codigo medico] TEXT (4) ALTER TABLE CAGT0002 ADD COLUMN [codigo paciente] TEXT (8) ALTER TABLE CAGT0002 ADD COLUMN fecha DATETIME ALTER TABLE CAGT0002 ADD COLUMN hora DATETIME ALTER TABLE CAGT0002 ADD COLUMN texto TEXT(255) ALTER TABLE CAGT0002 ADD COLUMN observaciones LONGTEXT -- CAGT0105: Motivos de Alta CREATE TABLE CAGT0105 ([MotivoAlta] TEXT (12) NOT NULL, CONSTRAINT CAGT0105_PK Primary Key ([MotivoAlta])) ALTER TABLE CAGT0105 ADD COLUMN [Descripcion] TEXT (50) -- CAGT0171: Empresas CREATE TABLE CAGT0171 ([Empresa] TEXT (12) NOT NULL, CONSTRAINT CAGT0171_PK Primary Key ([Empresa])) ALTER TABLE CAGT0171 ADD COLUMN [NombreEmpresa] TEXT (50) -- CAGT0201: Otros Médicos CREATE TABLE CAGT0201 ([Medico] TEXT (12) NOT NULL, CONSTRAINT CAGT0201_PK Primary Key ([Medico])) ALTER TABLE CAGT0201 ADD COLUMN [Tratamiento] TEXT (10) ALTER TABLE CAGT0201 ADD COLUMN [Nombre] TEXT (50) ALTER TABLE CAGT0201 ADD COLUMN [Apellidos] TEXT (50) --- Otros ALTER TABLE CAGT0101 ADD COLUMN TipoEpisodio TEXT (12) CREATE TABLE CAGT0181 ([Tratamiento] TEXT (12) NOT NULL, [Descripcion] TEXT (50) NOT NULL, [Tiempo] Date NOT NULL, [Maquina] TEXT(12), [Color] LONG, CONSTRAINT CAGT0181_PK Primary Key ([Tratamiento])) CREATE TABLE CAGT0191 ([Maquina] TEXT (12) NOT NULL, [Descripcion] TEXT (50) NOT NULL, [NumeroMaquinas] INTEGER, CONSTRAINT CAGT0191_PK Primary Key ([Maquina])) -- CAR -- Parámetros ALTER TABLE CART0001 ADD COLUMN [estado pendiente cobro] TEXT (4) ALTER TABLE CART0001 ADD COLUMN TextoCeldaSize BYTE ALTER TABLE CART0001 ADD COLUMN FormularioBusquedaServicios BYTE ALTER TABLE CART0001 ADD COLUMN ServicioForzarEnCelda BIT -- Médicos ALTER TABLE CART0011 ADD COLUMN HoraInicioEspecial DATETIME ALTER TABLE CART0011 ADD COLUMN VisitaSemanas BYTE NOT NULL UPDATE CART0011 SET VisitaSemanas = 2 WHERE VisitaSemanas Is Null; -- Bloqueos ALTER TABLE CART0012 ADD COLUMN Tratamiento TEXT (12) -- Servicios ALTER TABLE CART0021 ALTER COLUMN descripcion TEXT(200) ALTER TABLE CART0021 ADD COLUMN TextoCOMB TEXT (100) ALTER TABLE CART0021 ADD COLUMN VerEnCelda BIT -- Tarifas de ervicios ALTER TABLE CART0041 ADD COLUMN Intervencion BIT -- CART0053: Tipos de Mutuas CREATE TABLE CART0053 ([TipoMutua] TEXT (12) NOT NULL, CONSTRAINT CART0053_PK Primary Key ([TipoMutua])) ALTER TABLE CART0053 ADD COLUMN [Descripcion] TEXT (50) -- CART0101 Pacientes ALTER TABLE CART0101 ADD COLUMN Efectivo BIT -- CHC CREATE TABLE CHCT0117 ([codigo paciente] TEXT (7) NOT NULL, [episodio] LONG NOT NULL, [code] TEXT (50) NOT NULL, [Observaciones] MEMO, CONSTRAINT CHCT0113_PK Primary Key ([codigo paciente], episodio, code)) -- CGT -- CGTT0401 Productos ALTER TABLE CGTT0401 ADD COLUMN Efectivo BIT ALTER TABLE CGTT0401 ADD COLUMN CodigoBarras TEXT (50) -- CGTT0511 Movimientos de Productos ALTER TABLE CGTT0511 ADD COLUMN Efectivo BIT ALTER TABLE CGTT0511 ADD COLUMN SerieFactura TEXT (2) ALTER TABLE CGTT0511 ADD COLUMN NumeroFactura Long | ||||||||||||||||
Buscar un registro en Access 2003Este 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 | ||||||||||||||||
Buscar valor en celdaBucle 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 | ||||||||||||||||
Campos calculados en informesControl 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 | ||||||||||||||||
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 | ||||||||||||||||
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 | ||||||||||||||||
Como crear un hipervínculo en un formularioHay 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:
| ||||||||||||||||
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 | ||||||||||||||||
Contar un carácterSi 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 | ||||||||||||||||
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. Ver fuente | ||||||||||||||||
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 FunctionNotas: 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. | ||||||||||||||||
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 | ||||||||||||||||
Desplegable en Access combinando dos campos, uno de ellos nuloTí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]) | ||||||||||||||||
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 | ||||||||||||||||
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 | ||||||||||||||||
Eliminar caracteres especiales de una cadenaFunció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 BasicUn par de ejemplos de algunas equivalencias entre ambos lenguajes para tratar cadenas....
| ||||||||||||||||
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 | ||||||||||||||||
Extensión de un archivoComo 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 FunctionUn 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 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 | ||||||||||||||||
Filtro y orden de registros de un formularioCó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 | ||||||||||||||||
ID de un nuevo registroCó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 | ||||||||||||||||
Ir al final de un campoComo 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 | ||||||||||||||||
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 | ||||||||||||||||
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 | ||||||||||||||||
Len: Contar caracteres en una cadenaLa 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 | ||||||||||||||||
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 | ||||||||||||||||
Microsoft Flexgrid en Access 365 con Windows 10El 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:
| ||||||||||||||||
Minutos a formato HH:NN stringEn 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 | ||||||||||||||||
Obtener ID despues de AddnewCó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 | ||||||||||||||||
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:
| ||||||||||||||||
Primer y último día de la semanaComo 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 | ||||||||||||||||
Propiedad ControlSource en un Formulario AccessEjemplo 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") | ||||||||||||||||
Quitar el último carácter de una cadenaCó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" | ||||||||||||||||
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 | ||||||||||||||||
Reemplazar string en una cadenaLa 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 izquierdaPara 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 1Ejemplo 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. | ||||||||||||||||
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 | ||||||||||||||||
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 | ||||||||||||||||
SplitSepara 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" | ||||||||||||||||
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 & """" | ||||||||||||||||
Subcadena por delimitadoresObtener 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 | ||||||||||||||||
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 | ||||||||||||||||
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 """" | ||||||||||||||||
Vibración de letras en formularios de Microsoft AccessLas 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. |
Desarrollado con el plugin AB Dictionary para 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.