Noticias:

Reinstalando todo...

Menú Principal

Mensajes recientes

#71
Base de datos / Forzar macro AutoKeys
Último mensaje por xavi - Enero 21, 2020, 07:18:06 PM
Palabras clave: propiedad, base de datos, macro, autokeys
Autor: No lo sé
Extraído de: MVP-Access.com


A raíz de un error presentado por John Ochoa en que la macro AutoKeys parece no dispararse, el mismo responde con la solución. Hay que forzar la propiedad de la aplicación.



Application.SetOption "Key Assignment Macro", "Autokeys"

#72
Consultas / Filtrar una consulta los regis...
Último mensaje por xavi - Enero 14, 2020, 06:23:58 PM
Palabras clave: consulta, filtrar, asterisco, comodín
Extraído de: Encontrado en la web


Pregunta
Mediante una consulta, ¿Cómo construir el operador Like para que devuelva los registros que empiezan por asterisco?

Encontrado en la web

Para que un carácter comodín (asterisco o cierre de interrogación) no se comporten como tal  es necesario ponerlos entre corchetes:

Like "[*]*"


#73
Base de datos / Obtener/establecer propiedades...
Último mensaje por xavi - Diciembre 09, 2019, 08:05:14 PM
Palabras clave: propiedades, opciones, base de datos
Autor: theDBguy's Access Blog


Objetivo:
Obtener o establecer las propiedades de una base de datos


Link
#74
DAO / Filtrar un recordset abierto
Último mensaje por xavi - Diciembre 08, 2019, 11:13:06 PM
Palabras clave: DAO, recordset, filtrado, filter
Autor: ¿Ayuda de Microsoft?


Objetivo:
Utilizar un recordset previamente abierto como base de otro.

Método
Teniendo un recordset abierto, tener un segundo recordset dónde sólo se muestren los datos filtrados. Ejemplo:


    Dim rst As DAO.Recordset
    Dim rstFiltrado As DAO.Recordset
   

    Set rst = CurrentDb.OpenRecordset("SELECT * FROM unaTabla WHERE UnCampo = '" & unValor & "'")
    rst.Filter = "OtroCampo = 'otroValor'"
    Set rstFiltrado = rst.OpenRecordset
    ' Acciones
    rstFiltrado.Close
    Set rstFiltrado = Nothing

#75
Base de datos / Compactar base de datos extern...
Último mensaje por xavi - Noviembre 10, 2019, 07:56:24 PM
Palabras clave: compactar, base de datos, externa
Autor: No lo sé
Extraído de: No lo sé

Objetivo:
Compactar un base de datos pasada como argumento


Function CompactarOtraBDD(strFullPath As String)
    On Error GoTo ErrorHandler
   
    Dim strNewNombre    As String
    Dim strBackend      As String
   
    ' Función para compactar una base de datos externa
   
    ' Comprobamos si alguien está conectado a la base de datos. Simplemente miramos si existe el laccdb
    If Len(Dir(Replace(strFullPath, ".accdb", ".laccdb"), vbArchive)) > 0 Then
        ' Parece bloqueado
        MsgBox "La base de datos está en uso. Espere a que sea liberada para poder compactarla.", vbExclamation, cStrTitMb
        Exit Function
    End If
   
    strNewNombre = Replace(strFullPath, ".accdb", "_Backup.accdb")
    If Len(Dir(strNewNombre, vbArchive)) > 0 Then
        ' Borramos backup previo
        Kill strNewNombre
    End If
   
    DBEngine.CompactDatabase DamePathCompletoDatos, strNewNombre
    ' Borramos el BackEnd
    Kill strFullPath
   
    ' Renombramos el backup
    Name strNewNombre As strFullPath

ExitProcedure:
    On Error GoTo 0
    Exit Function
ErrorHandler:
    Select Case Err.Number
        Case 0
        Case Else
            MsgBox "Error " & Err.Number & " - " & Err.Description & vbNewLine & _
                    "Procedimiento: CompactarOtraBDD" & vbNewLine & _
                    "Módulo: " & Application.VBE.ActiveCodePane.CodeModule.Name, vbCritical, "AVISO"
            Resume ExitProcedure
    End Select
End Function

#76
Base de datos / Establecer título e icono
Último mensaje por xavi - Septiembre 22, 2019, 11:27:22 PM
Palabras clave: icono, asociar, application, seticon
Autor: Sacado de centro de desarrolladores Microsoft


Objetivo:
Establecer el título y el icono de la aplicación en tiempo de ejecución.




Sub cmdAddProp_Click()
Dim intX As Integer
Const DB_Text As Long = 10
intX = AddAppProperty("AppTitle", DB_Text, "My Custom Application")
intX = AddAppProperty("AppIcon", DB_Text, "C:\Windows\Cars.bmp")
CurrentDb.Properties("UseAppIconForFrmRpt") = 1
Application.RefreshTitleBar
End Sub

Function AddAppProperty(strName As String, _
varType As Variant, varValue As Variant) As Integer
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270

Set dbs = CurrentDb
On Error GoTo AddProp_Err
dbs.Properties(strName) = varValue
AddAppProperty = True

AddProp_Bye:
Exit Function

AddProp_Err:
If Err = conPropNotFoundError Then
Set prp = dbs.CreateProperty(strName, varType, varValue)
dbs.Properties.Append prp
Resume
Else
AddAppProperty = False
Resume AddProp_Bye
End If
End Function
#77
Módulos / Averiguar si existe un procedi...
Último mensaje por xavi - Septiembre 03, 2019, 01:23:14 AM
Palabras clave: Averiguar, saber, existe, procedimiento, código
Autor: Xavi


Objetivo:
A veces, durante la vida de una aplicación, es necesario lanzar procedimientos con nombres de funciones que pueden no existir en nuestra aplicación. Para averiguar si existen, tengo un pequeño módulo que me ayuda



' ****************************************************************************
' Versión:                      1.000
' Fecha última modificación:    02/09/2019
' Propósito:                    Averiguar si existe módulo y/o procedimiento
' ****************************************************************************
' Ver final del módulo para historial de versiones
' ****************************************************************************


Function ExisteModulo(strModule As String) As Boolean
    On Error GoTo ErrorHandler
   
    Dim mdl As AccessObject
   
    For Each mdl In CurrentProject.AllModules
        If mdl.Name = strModule Then
            ExisteModulo = True
            Exit Function
        End If
    Next
               
    ExisteModulo = False

ExitProcedure:
    On Error GoTo 0
    Exit Function
ErrorHandler:
    Select Case Err.Number
        Case 0
        Case Else
            MsgBox "Error " & Err.Number & "-" & Err.Description
            Resume ExitProcedure
    End Select
End Function

Function ExisteProcedimiento(strModule As String, strProcedureName As String) As Boolean
    On Error GoTo ErrorHandler
   
    Dim mdl         As Module
    Dim lngSLine    As Long
    Dim lngSCol     As Long
    Dim lngELine    As Long
    Dim lngECol     As Long
    Dim strLine     As String
    Dim strNewLine  As String
    Dim intChr      As Integer
    Dim intBefore   As Integer
    Dim intAfter    As Integer
    Dim strLeft     As String
    Dim strRight    As String

    If ExisteModulo(strModule) Then
        Set mdl = Modules(strModule)
    Else
        ExisteProcedimiento = False
    End If
   
    If mdl.Find(strProcedureName, lngSLine, lngSCol, lngELine, lngECol) Then
        ExisteProcedimiento = True
    Else
        ExisteProcedimiento = False
    End If
    Set mdl = Nothing

ExitProcedure:
    On Error GoTo 0
    Exit Function
ErrorHandler:
    Select Case Err.Number
        Case 0
        Case 7961
            ' No parece que podamos acceder a él
            DoCmd.OpenModule strModule
            Resume
        Case Else
            MsgBox "Error " & Err.Number & "-" & Err.Description
            Resume ExitProcedure
    End Select
End Function

' *****************  HISTORIAL ********************  HISTORIAL ********************  HISTORIAL ********************  HISTORIAL ********************
'   Fecha       Versión Procedimiento           Descripción
'   ----------  ------- ----------------------- --------------------------------------------------------------------------------------------------
'   02/09/2019  1.001                           Primera versión documentada

#78
Varias / Referencias
Último mensaje por xavi - Noviembre 02, 2017, 06:51:49 PM
Palabras clave: referencias, librerias
Autor: Xavi
Extraído de: Foro MVP-Access

Antecedentes
Escenario.
Se está programando en Office 2010. Se tiene marcada la referencia a la biblioteca de Excel (14.0).
Si se manda la aplicación a un cliente que disponga de una versión superior, la aplicación automáticamente adaptará la versión de la librería a la versión superior
Si se manda la aplicación a un cliente que disponga de una versión inferior, el sistema no es capaz de adaptarse y "casca"

La solución óptima pasa por NO UTILIZAR las bibliotecas y referenciar genéricamente. Pero eso es muy engorroso si hay muchas declaraciones en la base de datos.

La solución que yo utilizo se basa en utilizar un módulo dónde se declaran las variables que se utilizaran en toda la aplicación.

El código el módulo (después la explicación):


Option Compare Database
Option Explicit

' Definimos las bibliotecas a utilizar
#Const UseObjectLibrary_XLS = True
#Const UseObjectLibrary_OLK = True
#Const UseObjectLibrary_FSO = False
#Const UseObjectLibrary_MSO = False

' ##################################################    EXCEL
#If UseObjectLibrary_XLS Then
    Public Const blnUseObjectLibrary_XLS    As Boolean = True
    Public xlsApp                  As Excel.Application
#Else
    Public Const blnUseObjectLibrary_XLS    As Boolean = False
    Public xlsApp                  As Object
    Public Const xlVeryHidden = 2
    Public Const xlPrintNoComments = -4142
    Public Const xlLandscape = 2
    Public Const xlAutomatic = -4105
    Public Const xlDownThenOver = 1
    Public Const xlPrintErrorsDisplayed = 0
    Public Const xlDelimited = 1
    Public Const xlTextQualifierDoubleQuote = 1
    Public Const xlWorkbookDefault = 51
    Public Const xlOpenXMLWorkbook = 51
    ' Validaciones de datos
    Public Const xlValidateList = 3
    Public Const xlValidateDecimal = 2
    Public Const xlValidAlertStop = 1
    Public Const xlGreaterEqual = 7
    Public Const xlBetween = 1
    ' Bordes
    Public Const xlEdgeLeft = 7
    Public Const xlEdgeTop = 8
    Public Const xlEdgeBottom = 9
    Public Const xlEdgeRight = 10
    Public Const xlContinuous = 1
    Public Const xlColorIndexAutomatic = -4105
    Public Const xlHairline = 1
    Public Const xlMedium = -4138
    Public Const xlThick = 4
    Public Const xlThin = 2
   
#End If

' ##################################################    OUTLOOK
#If UseObjectLibrary_OLK Then
    Public Const blnUseObjectLibrary_OUT    As Boolean = True
    Public olkApp           As Outlook.Application
    Public olkNs            As Outlook.Namespace
    Public olkFolder        As Outlook.Folder
    Public olkItems         As Outlook.Items
    Public olkRestrictedItems   As Outlook.Items
    Public olkMailItem      As Outlook.MailItem
    Public olkPrp           As Outlook.UserProperty
    Public olkAccount       As Outlook.Account
    Public olkAttach        As Outlook.Attachment
#Else
    Public Const blnUseObjectLibrary_OUT    As Boolean = False
    Public olkApp           As Object
    Public olkNs            As Variant
    Public olkFolder        As Object
    Public olkMail          As Variant
    Public olkPrp           As Variant
    Public olkAccount       As Variant
    Public olkAttach        As Variant
    Public Const olMailItem = 0
    Public Const olMSG = 3
    Public Const olByValue = 1
    Public Const olByReference = 4
    Public Const olFormatPlain = 1
    Public Const olFormatHTML = 2
#End If

' ##################################################    Microsoft Scripting Runtime
#If UseObjectLibrary_FSO Then
    Public fso              As Scripting.FileSystemObject
    Public fsoFile          As File
    Public fsoDrive         As Drive
#Else
    Public fso              As Object
    Public fsoFile          As Object
    Public fsoDrive         As Object
    Public Const ForReading = 1
#End If

' ##################################################    Microsoft Office x.xx
' La Object Library en los FileDialog
#If UseObjectLibrary_MSO Then
    Public fDialog          As Office.FileDialog
#Else
    Public fDialog          As Object
    Public Const msoFileDialogOpen = 1
    Public Const msoFileDialogSaveAs = 2
    Public Const msoFileDialogFilePicker = 3
    Public Const msoFileDialogFolderPicker = 4
#End If


Este código está copiado durante el periodo de desarrollo.
En mis aplicaciones, generalmente, se utilizan 4 bibliotecas adicionales: Excel, Outlook, FileSystem y Office. En alguna aplicación también se utiliza Word.

Después de las opciones vemos un primer bloque dónde se definen, como directiva, unas variables que indican si se va a utilizar o no la biblioteca. En este caso vemos que las de Excel y Outlook si mientras que FSO y Office no.

Después existen los distintos bloques IF..THEN...ELSE (también como directiva) dónde se evalúa la constante anterior para realizar las declaraciones de variables adecuadas a la utilización o no de la biblioteca.

En el bloque Excel vemos que, cuando se utiliza la biblioteca, la variable xlsApp se declara como Excel.Application mientras que, si no se utiliza, se declara como Object.
También vemos que, cuando no se utiliza la biblioteca, se declaran todas las constantes que se van a ir utilizando durante la aplicación.

En el caso de Outlook se ve más clara aun la diferencia entre declarar como Object/Variant o explicitamente.

Obviamente, las declaraciones a nivel de procedimiento desaparecen.

En definitiva se trata de ir cambiando el valor de las primeras constantes.
--> al programar: marcamos las bibliotecas y ponemos las constantes de directiva a True. Ello nos proporciona acceso a todos los métodos y constantes de la biblioteca
--> al dejar de programar: desmarcamos las bibliotecas y ponemos las constantes a False.
En ese momento conviene lanzar el depurador por si hubiéramos incluido alguna nueva constante específica de la biblioteca.
#79
Varias / Averiguar líneas fichero texto
Último mensaje por xavi - Mayo 10, 2017, 03:56:39 PM
Palabras clave: líneas, filas, fichero, archivo, texto, txt
Autor: Rubén Vigón
Extraído de: Foro MVP-Access

Antecedentes
Se necesita una función para averiguar la cantidad de líneas de un fichero de texto. Por la red encontramos este código (se obvian declaraciones de variables):


    f = FreeFile
    Open Me!PathA1 For Input As #f
    linea = 0
    Do Until EOF(f)
        Line Input #f, strLineaIn
        linea = linea + 1
    Loop
    Close #f
    lngTotalRegistros = linea


Para un fichero con 10000 líneas se tarda aproximadamente 2.5 segundos (seguro que la potencia de la máquina influye) en obtener la cantidad de registros.

¿Hay una forma más rápida? Pues sí: este propuesto por Rubén Vigón.


Function fntDameLineasFichero(ByVal strRuta As String) As Long
    Dim f As Integer
    Dim strTexto As String
    Dim arrLineas() As String
   
    f = FreeFile
    Open strRuta For Input As #f
    strTexto = Input(LOF(f), #f)
    Close #f
    arrLineas = Split(strTexto, vbNewLine)
    fntDameLineasFichero = UBound(arrLineas) - LBound(arrLineas) + 1
    Erase arrLineas
End Function


Para el mismo fichero devuelve la respuesta en 0.035 segundos
#80
Varias / Crear BDD sin Access
Último mensaje por xavi - Noviembre 29, 2016, 11:44:28 PM
Palabras clave: bdd, Excel, Access, crear
Autor: Mihura y Emilio
Extraído de: Foro MVP-Access

Antecedentes
En este hilo del foro aparece la necesidad de poder crear una base de datos Access en una máquina dónde no está instalado Access.

Cita de: Mihura
Para crearte una mdb desde Excel basta con usar el siguiente módulo:


Private Sub RT_CreateDatabase(NombreBD As String)
'Creamos una database con ADO, tiene que estar referenciada la libreria Microsoft ActiveX Data Objects (yo suelo usar la 2.8)
Dim Catalog As Object
   
    Set Catalog = CreateObject("ADOX.Catalog")
    Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & NombreBD & ";"
    Set Catalog = Nothing

End Sub



Cita de: Emilio
Utilizando:
Catalog.Create "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & NombreBD & ";"
podremos crear una en formato 2007-2010 (accdb)