Plazo de días hábiles

Con el siguiente ejemplo se obtiene la fecha en la que finaliza una plazo hábil determinado por la fecha de inicio y el número de días que deben transcurrir. Para calcular la mencionada fecha se tienen en cuenta tanto sábados como domingos, como los días festivos que se añadan a la tabla que contiene la base de datos.

El día que proporciona la función es el día siguiente a la finalización del plazo, no el último día del plazo.

Descargar. Access 2000

Como respuesta a una de las peticiones de Fatiga (realizada en los comentarios) añado una nueva versión del ejemplo anterior. En esta nueva versión se añaden las siguientes modificaciones:

• En el caso de que el primer día del plazo sea inhábil muestra una etiqueta en el formulario que avisa de este hecho.
• El primer día del cómputo es la fecha de inicio, y no el día siguiente. Así si la fecha de inicio es el día 17/11/2008 y el plazo de días es 5, el resultado es el 21/11/2008 y no el 22/11/2008 o siguiente hábil.

Descargar. Access 2000

Siguiendo con las peticiones de Fetiga dejo un nuevo ejemplo basado en los anteriores en los en un informe se muestra la fecha del primer día hábil.

Descargar. Access 2000

Búsqueda activa en subformulario, sin tildes

Un paso más en la búsqueda activa/selectiva en un formulario. Mediante el siguiente ejemplo se realiza la búsqueda de datos independientemente de que la cadena que se busca contenga o no tildes.

Descargar. Access 2000

Abrir tabla externa sin vincular

Con el siguiente código se puede abrir desde una MDB las tabla de otra MDB sin hacer vinculación ni automatización:

Sub AbrirTbl(ByVal Rutaservidor As String)
Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("SELECT *  FROM Flash IN '" & Rutaservidor & "';")
While Rst.EOF = False
'Recorre el recordset
MsgBox Rst.Fields(0)
Rst.MoveNext
Wend
Rst.Close
Set Rst = Nothing
End Sub

Para llamar a esta funcion:

Sub Prueba()
AbrirTbl "U:\Publicaciones\Planificacion\Bases de datos\Fundición_be.mdb"
End Sub

y debería funcionar…

Fuente: Access de Xavi

Mensaje de información en la barra de tareas

El siguiente ejemplo muestra como hacer aparecer el ‘típico’ mensaje de la barra de tareas que informa, advierte, …, sobre las distintas actuaciones que se están llevando a cabo en la máquina (el globo de información que aparece junto al reloj de la barra de tareas).

Descargar. Access 2003

Fuente: Utter Access

Vincular tablas dbf

La siguiente función revincula una tabla formato dbf:

Function VincularDBF(strPath As String, strTable As String)
On Error GoTo Err_VincularDBF
Dim tdf As TableDef
For Each tdf In CurrentDb.TableDefs
If Left(tdf.Connect, 5) = "Dbase" And tdf.Name = strTable Then
a = Left(tdf.Connect, InStr(tdf.Connect, "DATABASE") - 1)
a = a + "DATABASE=" & Mid(strPath, 1, Len(strPath) - Len(strTable) - 4)
'El 4 es para quitar la extensión del archivo
tdf.Connect = a
tdf.RefreshLink
End If
Next
VincularDBF = 0
Exit_VincularDBF:
Exit Function
Err_VincularDBF:
VincularDBF = Err.Number
Resume Exit_VincularDBF
End Function

Barra de progreso

Un método muy común de obtener una barra de progreso sobre una consulta de acción, es realizar los procesos uno a uno recorriendo un recordset. Cada vez que nos situamos en un nuevo registro, incrementamos el valor de la barra de progreso e invocamos un método del recordset (AddNew, Delete o Update). El inconveniente es que si la cantidad de registros a procesar es elevada, este sistema puede resultar inacabable. Es mucho más rápido dejar que el proceso lo realice el lenguaje sql.
La idea sería invocar una función dentro de la clausula where de la consulta de acción. Dicha función se encargaría de crear una barra de progreso y de ir aumentando su tamaño según las llamadas a la misma.

El primer parámetro de la función es una referencia a cualquier campo de la consulta. Al hacer esto, obligamos a que la función sea invocada para cada registro. El segundo parámetro de la función, es una sql que nos sirva para calcular el número total de registros a procesar.

Public Function BarraProgreso(Valor As Variant, sql As String) As Boolean
Dim rst as DAO.Recordset
'Si es la primera llamada a la función, calculamos el número total
'de registros a procesar e iniciamos la barra de progreso
If Contador = 0 Then
Set rst = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
If rst.recordcount = 0 Then
Límite = 0
Else
Límite = rst.RecordCount
End if
rst.close
Set rst = Nothing
SysCmd acSysCmdInitMeter, "Progreso de la consulta ...", Límite
End If
Contador = Contador + 1
'Pasamos el número de registros procesados a la barra de progreso
SysCmd acSysCmdUpdateMeter, Contador
BarraProgreso = True
'Si hemos llegado al último registro, ponemos las variables a cero
'y borramos la barra de progreso.
If Contador >= Límite Then
SysCmd acSysCmdRemoveMeter
Límite = 0
Contador = 0
End If
End Function

El funcionamiento de la función sería el siguiente:

MsgBox "Vamos a iniciar la primera consulta ..."
CurrentProject.Connection.Execute "Select * Into Copia From [Detalles de pedidos] Where BarraProgreso(IdPedido, 'Select Count(*) From [Detalles de pedidos]')=True"

Fuente: www.mvp-access.com

Sustituir carácter de una cadena

La siguiente función reemplaza en la cadena pasada como parámetro, cada uno de los caracteres incluidos en la cadena strBuscar por el situado en la misma posición en la cadena strReemplazarCon por ese motivo ambas cadenas han de ser formadas por igual número de caracteres. Argumentos: strTexto => cadena a la que se han de hacer los cambios; strBuscar => cadena de letras a ser reemplazadas; strReemplazarCon => cadena de letras a reemplazar. La forma de llamara a la función sería la siguiente: strTexto = ReplaceExt(strTexto, “áéíóúü”, “aeiouu”).

La función es para Access 2000 ó superior. Ya que utiliza la función replace. Para usarla en Access 97 utiliza una función que sustituya a replace.

Public Function ReplaceExt(strTexto As String, strBuscar As String, strReemplazarCon As String) As String Dim i As Long
If Len(strBuscar) = Len(strReemplazarCon) Then
For i = 1 To Len(strBuscar)
strTexto = Replace(strTexto, Mid(strBuscar, i, 1), Mid(strReemplazarCon, i, 1))
Next i
ReplaceExt = strTexto
Else
MsgBox "La longitud de las cadenas no coincide", vbOKOnly + vbCritical, "ATENCION"
End If
End Function

Fuente: www.mvp-access.com

Ocultar las tablas de una base de datos

La siguiente función oculta las tablas de la base de datos añadiendo el atributo DB_HIDDENOBJECT a cada una de las tablas:

Function OcultaDesoculta(Ocultar As Boolean) Dim Tablas As TableDef
For Each Tablas In CurrentDb.TableDefs
If Ocultar = True Then
If Not (Tablas.Attributes And DB_HIDDENOBJECT) Then
Tablas.Attributes = Tablas.Attributes + DB_HIDDENOBJECT
End If
Else
If (Tablas.Attributes And DB_HIDDENOBJECT) Then
Tablas.Attributes = Tablas.Attributes - DB_HIDDENOBJECT
End If
End If
Next
End Function

Y llama a esta funcion con el parametro False/TRUE, es decir OcultaDesoculta False, y no se verán las tablas de la base de datos ni de coña.

Fuente: accessbuho.mvps.org

Número correlativo en un campo numérico

Para generar un número correlativo en un campo numérico y que además tenga en cuenta los huecos dejados por anteriores eliminaciones de registros se puede utilizar la siguiente función. Es decir, suponiendo que los valores de ese campo numéricos fueran, por ejemplo: 1, 2, 3, 5, 6, 8, 9, 11, el código devolverá como resultado el 4. Una vez añadido el 4, la siguiente vez debería devolvería el 7, la siguiente el 10 y la siguiente el 12.

Function fCounter(FieldName As String, TableName As String, Optional DbPath As String) As Long
Dim SQL As String
Dim db As Object ‘DAO.Database
Dim rst As Object ‘DAO.Recordset
On Error GoTo fCounter_Error
SQL = “SELECT ” & FieldName & ” FROM ” & TableName & ” WHERE ” & FieldName & ” = 1″
If DbPath = “” Then
Set db = CurrentDb
Else
Set db = DBEngine.OpenDatabase(DbPath)
End If
Set rst = db.OpenRecordset(SQL, DB_OPEN_SNAPSHOT)
If rst.EOF Or rst.BOF Then
fCounter = 1
Else
SQL = “SELECT ” & TableName & “.” & FieldName & ” + 1″ & ” FROM ” & TableName & ” LEFT JOIN ” & TableName & ” AS TMP” & ” ON ” & TableName & “.” & FieldName & ” + 1″ & ” = TMP.” & FieldName & ” WHERE TMP.” & FieldName & ” IS NULL” & ” ORDER BY ” & TableName & “.” & FieldName
Set rst = db.OpenRecordset(SQL)
fCounter = rst(0)
End If
Exit_Function:
If Not rst Is Nothing Then rst.Close
Set rst = Nothing
If Not db Is Nothing Then db.Close
Set db = Nothing
On Error GoTo 0
Exit Function
fCounter_Error:
MsgBox “Error ” & Err.Number & ” (” & Err.Description & “)”
Resume exit_Function
End Function

La llamada a la función sería de la siguiente forma:

SiguienteNumero = fCounter(“campo_numerico”, “Tabla”)

Fuente: Access & VBA