Access siglo XXI

Albañilería de software con Access 2007
Principal     El blog     El Foro     Trucos     Utilidades     Enlaces     Amigos     Acerca de mí     Ribbon      
Apoculo.net
McPegasus
Spaces.Live Mcpegasus
 
El blog de McPegasus en Spaces
 
24 July

ODT, Office Develper Tools, Office Developer Edition, MOD, Microsoft Office Developer, ADE, Access Developer Extensions

 

Office Developer

Este documento proporciona información acerca de Microsoft Office Developer en todas sus versiones para Access

 

Microsoft Access Developer y su terminología.

Existen o existieron del Office distintas versiones comerciales (versiones internas en paréntesis), 2.0, 95 (7), 97 (8), 2000 (9), 2002 XP (10), 2003 (11) y 2007 (12), en las que en cada paquete de Office (según composición) se incluye la aplicación llamada Access.
En cada una de las versiones del Office generaron también una herramienta para que un desarrollador (developer) pudiera crear paquetes instalables de una aplicación creada en Access con la posibilidad de incluir también el llamado RunTime.
Dicha herramienta es externa al propio Office y hay que adquirirla por separado excepto en la versión del 2007 usando los nombres siguientes según las versiones,

  • Access 2.0 = ODT, Office Developer’s Toolkit 1.1
  • Access ADT 95, Access Developer’s Toolkit 2.0
  • Access 2000 = MOD2000, Microsoft Office 2000 Developer
  • Access 97 = ODE97, Microsoft Office 97 Developer Edition
  • Access 2002 XP = MOD xp, Microsoft Office Developer
  • Access 2003 = ADE2003, Access Developer Extensions
  • Access 2007 = ADE2007, Access Developer Extensions

Ha ido cambiando en su contenido, teniendo desde varias herramientas de ayuda a quedarse con un simple y no por ello funcional “Extensión de programa”.

 

Access ADT95

Vínculos de interés

 

Access MODxp

El contenido de este paquete es el siguiente.

  • Code Librarian, librerías con código de ejemplo.
  • Code Librarian Viewer, un visualizador de librerías de API.
  • Microsoft Development Environment.
  • Microsoft Smart Tag SDK.
  • Packaging Wizard, es un asistente que te ayuda a generar un instalable, en él puedes o no incluir el RunTime, el MSDE (Microsoft Data Engine). Consigues unos archivos Setup.exe, .cab, donde puedes crear un CD y usar para instalar la aplicación en otros equipos.
  • Replication Manager 4.0, un entorno para controlar las replicaciones de bases de datos que puedas tener dispersas por todo el mundo manteniendo en todas ellas la misma estructura de datos en caso de modificación o actualización.
  • Add-In Property Scanner, (añadido de escáner de propiedad) para buscar a nivel global dentro de una solución Access 2003 una cadena concreta, y salte directamente al objeto en el que la cadena está localizada.

Problema encontrado.

 

Access ADE2003

Especificar que ADE2003 pertenece al paquete llamado Visual Studio Tools para Office, un conjunto de herramientas para desarrolladores. (Visual Studio Tools for Office System (VSTO))
Se puede descargar un documento de Hoja de producto con la documentación completa.
Se extrae de ella lo más significativo,

  • Para utilizar Microsoft Office Access 2003 Developer Extensions debe disponer del producto ya instalados Microsoft Office Professional Edition 2003 o Microsoft Office Access 2003.
  • ADE también incluye la licencia runtime de Access permitiendo así la distribución de soluciones basadas en Access 2003

Descargas relacionadas.

  • Office XP Service Pack 3 (SP3) para Access 2002 Runtime
    Descripción rápida: Office XP Service Pack 3 (SP3) para Access 2002 Runtime proporciona las actualizaciones más recientes a Access 2002 Runtime. Esta actualización contiene notables mejoras de seguridad, estabilidad y rendimiento.
    Nota: Instalación necesaria en el equipo cliente donde se ha instalado el Runtime.

 

Access ADE2007

En esta ocasión y presentado en modo "Extensión de Programa" podemos conseguir un empaquetador en modo asistente (Packaging Wizard) que nos ayuda a crear un instalable de un completo proyecto desarrollado en Access.

La gran aportación que nos trae para la versión de Access 2007 es que Microsoft lo entrega como un producto gratuito, así es, “strong>es gratis”.

Vínculos de interés

 

Runtime

Access Runtime, es un producto que consta del permiso de usar los archivos necesarios para ejecutar Access en una máquina que no esté instalado. Tan solo puedes ejecutar, no editar ni crear bases de datos.
Para conocer más sobre Runtime ir a la sección “Utilizar Access 2007 Runtime para implementar las aplicaciones” en la página “Introducción a las Extensiones para programadores de Access 2007 y a Access 2007 Runtime

 

Vínculos de interés

 

Autor

24 de julio de 2007

Rafael Andrada
Valencia [es]

www.mcpegasus.es
www.mcpegasus.net
www.live-mcpegasus.eu

..:: Tu Access, Mi Pasión ::..
[MVP Office System - Access]



07:57 GMT  |  Read comments(0)

19 June

Copiar al portapapeles (portafolios) del Windows
'***** Begin ***** Declaraciones para usar en rvg_SetClipBoard **********************************************************
Private Const GHND As Long = &H42
Private Const CF_TEXT As Long = &H1
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
'***** End **************************************************************************************************************
 
Public Sub rvg_SetClipBoard(ByVal strCadena As String)
'------------------------------------------------------------------------------------------------------------------------
' Sub           :   rvg_SetClipBoard                                                    Forma parte de McMódulosVXXXX.mdb
' Título        :   Copiar al portapapeles (portafolios) del Windows.
' Creación      :   19/06/2007 17:41
' Revisión      :   Copyright ©1999-2007 McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Origen        :   Gracias Rubén Vigón, http://groups.google.es:80/group/microsoft.public.es.vb/msg/b3ce518280c901fa
' Propósito     :   Copiar un texto que se pasa por parámetro al portapapeles del Windows.
'
'Argumento/s, la sintaxis del Procedimiento o Función consta de/los siguiente/s argumento/s:
'Parte              Descripción
'------------------------------------------------------------------------------------------------------------------------
'strCadena          Requerido   Cadena a copiar al portapapeles del Windows.
'------------------------------------------------------------------------------------------------------------------------
' Nota          :   Para visualizar el contenido del portapapeles, Inicio | Ejecutar | Clipbrd.exe
   
    Dim hGMem   As Long
   
On Error GoTo rvg_SetClipBoard_CapturarError
    hGMem = GlobalAlloc(GHND, Len(strCadena) + 1)
    lstrcpy GlobalLock(hGMem), strCadena
    If GlobalUnlock(hGMem) = 0 Then
        If OpenClipboard(0) Then
            EmptyClipboard
            SetClipboardData CF_TEXT, hGMem
            CloseClipboard
        End If
    End If
rvg_SetClipBoard_Salida:
    On Error GoTo 0
    Exit Sub
rvg_SetClipBoard_CapturarError:
    Select Case Err.Number
        Case Else
            'Cazar todos aquellos errores inesperados.
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure rvg_SetClipBoard."
    End Select
    'Salida a otro procedimiento.
    Resume rvg_SetClipBoard_Salida
End Sub


23:51 GMT  |  Read comments(0)

30 May

Crear una propiedad de un campo ya existente en tiempo de ejecución

Sub test_mcblnSetToCreateFieldProperty()
    Dim intItem             As Integer
   
    Dim strField            As String
    Dim strPathNamedbs      As String
    Dim strProperty(4)      As String
    Dim strPWD              As String
    Dim strTable            As String
    Dim strValue(4)         As String
   
   
    strPathNamedbs = Application.CurrentProject.Path & "\dMcCrearTablas.mdb"
   
    strTable = "tblPruebaAA"
    strField = "fldIdCampoAD"
   
    strProperty(0) = "AllowZeroLength"
    strProperty(1) = "Description"
    strProperty(2) = "Format"
    strProperty(3) = "UnicodeCompression"
    strProperty(4) = "DefaultValue"
   
    strValue(0) = "True"
    strValue(1) = "Descripción de " & strField
    strValue(2) = "Yes/No"
    strValue(3) = "True"
    strValue(4) = "Automatización"
   
    strPWD = ""
   
    Do While Not intItem = 5
        Debug.Print mcblnSetToCreateFieldProperty(strPathNamedbs, strTable, strField, strProperty(intItem), strValue(intItem), strPWD)
        intItem = intItem + 1
    Loop
End Sub
Public Function mcblnSetToCreateFieldProperty(ByVal strPathNamedbs As String, _
                                              ByVal strTable As String, _
                                              ByVal strField As String, _
                                              ByVal strProperty As String, _
                                              ByVal strValue As String, _
                                              Optional ByVal strPWD As String) As Boolean
'------------------------------------------------------------------------------------------------------------------------
' Function      :   mcblnSetToCreateFieldProperty                   Forma parte de McMódulosVXXXX.mdb
' Título        :   Crear una propiedad de un campo ya existente en tiempo de ejecución.
' Creación      :   30/05/2007 15:51
' Autor         :   Copyright ©1999-2007 McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Propósito     :   Crear una propiedad de una tabla ya existente. _
                    Código pensado y desarrollado para usar cuando se quiere actualizar la base de datos FrontEnd en _
                    una actualización al abrir la apps.
'------------------------------------------------------------------------------------------------------------------------
' Referencia/s  :   Nombre:     Microsoft DAO x.x Object Library
'                   Ruta:       C:\Archivos de programa\Archivos comunes\Microsoft Shared\DAO\daoxxx.dll
'------------------------------------------------------------------------------------------------------------------------
' Retorno       :   True / False, según se haya ejecutado el código con éxito o se haya producido un error.
'------------------------------------------------------------------------------------------------------------------------
'Argumento/s, la sintaxis del Procedimiento o Función consta de/los siguiente/s argumento/s:
'Parte              Descripción
'------------------------------------------------------------------------------------------------------------------------
'strPathNamedbs     Requerido   Ruta completa con nombre de la base de datos a crear la tabla.
'strTable           Requerido   Nombre de la tabla a crear.
'strField           Requerido   Nombre del primer campo a crear.
'strProperty        Requerido   Nombre de la propiedad a crear.
'strValue           Requerido   Valor de la propiedad a crear.
'strPWD             Optional    Contraseña de la dbs según strPathNamedbs.
'------------------------------------------------------------------------------------------------------------------------
   
    Dim dbs             As DAO.Database
   
    Dim tdf             As DAO.TableDef
   
    Dim fld             As DAO.Field
   
    Dim prp             As DAO.Property
   
    Dim blnActualizar   As Boolean                      'Para indicar que se actualiza el valor, no crear la propiedad.
    Dim blnSalirFor     As Boolean                      'Indicar a los Fors que ya se puede salir.
  
    Dim bytType         As Byte
   
   
On Error GoTo mcblnSetToCreateFieldProperty_CapturarError
    If strPWD = "" Then
        Set dbs = OpenDatabase(strPathNamedbs, True, False)
    Else
        Set dbs = OpenDatabase(strPathNamedbs, True, False, ";PWD=" & strPWD)
    End If
   
    Select Case strProperty
        Case "AllowZeroLength"          'Permitir longitud cero
            blnActualizar = True
            bytType = DAO.dbBoolean
        Case "Description"              'Descripción
            bytType = DAO.dbText
        Case "InputMask"                'Máscara de entrada
            bytType = DAO.dbText
        Case "UnicodeCompression"       'Compresión unicode
            bytType = DAO.dbBoolean
        Case "Format"                   'Formato
            bytType = DAO.dbText
        Case "DefaultValue"             'Valor predeterminado
            blnActualizar = True
            bytType = DAO.dbBoolean
        Case "ValidationRule"           'Regla de validación
            bytType = DAO.dbText
        Case "ValidationText"           'Texto de validación
            bytType = DAO.dbText
        Case "Required"                 'Requerido
            bytType = DAO.dbBoolean
    End Select
   
    If Not blnActualizar Then
        For Each tdf In dbs.TableDefs
            If tdf.Name = strTable Then
                For Each fld In tdf.Fields
                    If fld.Name = strField Then
                        For Each prp In fld.Properties
                            If prp.Name = strProperty Then
                                mcblnSetToCreateFieldProperty = True
                                Exit For
                            End If
                        Next prp
                        'Al pasar por el último bucle hay que indicar a los Each parents que se salga también.
                        blnSalirFor = True
                    End If
                    If blnSalirFor Then Exit For
                Next fld
            End If
            If blnSalirFor Then Exit For
        Next tdf
    End If
   
    If Not mcblnSetToCreateFieldProperty Then
        Set tdf = dbs.TableDefs(strTable)
        Set fld = tdf.Fields(strField)
       
        If blnActualizar Then
            fld.Properties(strProperty) = strValue
        Else
            Set prp = fld.CreateProperty(strProperty, bytType, strValue)
            fld.Properties.Append prp
        End If
       
        mcblnSetToCreateFieldProperty = True
    End If
   
mcblnSetToCreateFieldProperty_Salida:
    If Not prp Is Nothing Then Set prp = Nothing
    If Not fld Is Nothing Then Set fld = Nothing
    If Not tdf Is Nothing Then Set tdf = Nothing
       
    If Not dbs Is Nothing Then
        dbs.Close
        Set dbs = Nothing
    End If
    On Error GoTo 0
    Exit Function
mcblnSetToCreateFieldProperty_CapturarError:
    Select Case Err.Number
        Case Else
            'Cazar todos aquellos errores inesperados.
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure mcblnSetToCreateFieldProperty."
    End Select
    'Salida a otro procedimiento.
    Resume mcblnSetToCreateFieldProperty_Salida
   
End Function


06:58 GMT  |  Read comments(0)

Crear un campo en una tabla en tiempo de ejecución

Sub test_mcblnSetToCreateField()
    Dim bytType             As Byte
   
    Dim intSize             As Integer
    Dim intItem             As Integer
   
    Dim strField            As String
    Dim strPathNamedbs      As String
    Dim strPWD              As String
    Dim strTable            As String
   
   
    intItem = 0
   
    strPathNamedbs = Application.CurrentProject.Path & "\dMcCrearTablas.mdb"
    strPWD = ""
   
    strTable = "tblPruebaAA"
    strField = "fldIdCampoAB"
   
    bytType = DAO.dbText
    intSize = 100
   
    Debug.Print mcblnSetToCreateField(strPathNamedbs, strTable, strField, bytType, intSize, strPWD)
End Sub
Public Function mcblnSetToCreateField(ByVal strPathNamedbs As String, _
                                      ByVal strTable As String, _
                                      ByVal strField As String, _
                                      Optional bytType As Byte, _
                                      Optional ByVal intSize As Integer, _
                                      Optional ByVal strPWD As String) As Boolean
'------------------------------------------------------------------------------------------------------------------------
' Function      :   mcblnSetToCreateField
' Título        :   Crear un campo en una tabla en tiempo de ejecución.
' Creación      :   30/05/2007 15:10
' Autor         :   Copyright ©1999-2007 McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Propósito     :   Crear un campo en una tabla ya existente. _
                    Código pensado y desarrollado para usar cuando se quiere actualizar la base de datos FrontEnd en _
                    una actualización al abrir la apps.
'------------------------------------------------------------------------------------------------------------------------
' Referencia/s  :   Nombre:     Microsoft DAO x.x Object Library
'                   Ruta:       C:\Archivos de programa\Archivos comunes\Microsoft Shared\DAO\daoxxx.dll
'------------------------------------------------------------------------------------------------------------------------
' Retorno       :   True / False, según se haya ejecutado el código con éxito o se haya producido un error.
'------------------------------------------------------------------------------------------------------------------------
'Argumento/s, la sintaxis del Procedimiento o Función consta de/los siguiente/s argumento/s:
'Parte              Descripción
'------------------------------------------------------------------------------------------------------------------------
'strPathNamedbs     Requerido   Ruta completa con nombre de la base de datos a crear la tabla.
'strTable           Requerido   Nombre de la tabla a crear.
'strField           Requerido   Nombre del primer campo a crear.
'bytType            Optional   Determina el tipo de datos para el nuevo objeto Field. Si no se pasa será dbText. _
'intSize            Optional    Determina el tamaño del nuevo objeto Field que contenga texto. Si no se pasa será 255.
'strPWD             Optional    Contraseña de la dbs según strPathNamedbs.
'------------------------------------------------------------------------------------------------------------------------
   
    Dim dbs             As DAO.Database
   
    Dim tdf             As DAO.TableDef
   
    Dim fld             As DAO.Field
       
    Dim bytMétodo       As Byte                     'Método a seleccionar para crear el campo.
   
    Dim blnSalirFor     As Boolean                      'Indicar a los Fors que ya se puede salir.
   
    Dim strSql          As String
    Dim strType         As String
   
   
On Error GoTo mcblnSetToCreateField_CapturarError
    If strPWD = "" Then
        Set dbs = OpenDatabase(strPathNamedbs, True, False)
    Else
        Set dbs = OpenDatabase(strPathNamedbs, True, False, ";PWD=" & strPWD)
    End If
   
    For Each tdf In dbs.TableDefs
        If tdf.Name = strTable Then
            For Each fld In tdf.Fields
                If fld.Name = strField Then
                    mcblnSetToCreateField = True
                    Exit For
                End If
            Next fld
           'Al pasar por el último bucle hay que indicar a los Each parents que se salga también.
            blnSalirFor = True
        End If
        If blnSalirFor Then Exit For
    Next tdf
   
    If bytType = 0 Then
        bytType = DAO.dbText
    End If
   
    If Not mcblnSetToCreateField Then
       
        bytMétodo = 4
        'Esta explicación de métodos es para que me quede constancia de las diferentes posibilidades que tenemos para _
        realizar la misma operación de crear una tabla, la finalidad es la misma pero en según que ocasiones nos puede _
        interesar sobre todo en no declarar los objetos.
   
        If bytMétodo = 1 Then
            'Este primer método nos permite no declarar ningún objeto ni como Database, ni Tabledef, ni Field, es un _
            modo de proceder directo.
            OpenDatabase(strPathNamedbs, True, False).TableDefs(strTable).Fields.Append _
                    OpenDatabase(strPathNamedbs, True, False).TableDefs(strTable).CreateField(strField, bytType, intSize)
        ElseIf bytMétodo = 2 Then
            'Si tenemos necesidad de declarar una variable como objeto Database, esta sentencia es más corta.
            dbs.TableDefs(strTable).Fields.Append dbs.TableDefs(strTable).CreateField(strField, bytType, intSize)
        ElseIf bytMétodo = 3 Then
            'Más corto este tercer método aunque se debe de hacer en dos líneas.
            Set tdf = dbs.TableDefs(strTable)
            tdf.Fields.Append tdf.CreateField(strField, bytType, intSize)                 'Crear el campo.
        ElseIf bytMétodo = 4 Then
            'El método cuarto es el más estructurado aunque necesita declarar cada uno de los objeto.
            Set tdf = dbs.TableDefs(strTable)
            Set fld = tdf.CreateField(strField, bytType, intSize)
            tdf.Fields.Append fld
        ElseIf bytMétodo = 5 Then
            'Método que usa una sentencia SQL y que no es necesario DAO salvo cuando la tabla a crear está fuera de la _
            que ejecuta este código.
            If intSize = 0 Then intSize = 255
            Select Case bytType
                Case DAO.dbByte
                    strType = "BYTE"
                Case DAO.dbText
                    strType = "TEXT" & "(" & intSize & ")"
                Case DAO.dbInteger
                    strType = "INTEGER"
                Case DAO.dbMemo
                    strType = "MEMO"
                'etc. etc.
                Case Else
                    MsgBox "No se ha indicado un tipo de datos conocido.", vbCritical, "McPegasus informa"
            End Select
           
            strSql = "ALTER TABLE " & strTable & " ADD COLUMN " & strField & " " & bytType & ""
            dbs.Execute (strSql)
           
            'Método en caso de ejecutar en la propia dbs y sin DAO.
            'CodeDb.Execute (strSql)
        End If
    End If
mcblnSetToCreateField_Salida:
    If Not fld Is Nothing Then
        Set fld = Nothing
    End If
    If Not tdf Is Nothing Then
        Set tdf = Nothing
    End If
       
    If Not dbs Is Nothing Then
        dbs.Close
        Set dbs = Nothing
    End If
  
   On Error GoTo 0
   Exit Function
mcblnSetToCreateField_CapturarError:
    Select Case Err.Number
        Case Else
            'Cazar todos aquellos errores inesperados.
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure mcblnSetToCreateField."
    End Select
    'Salida a otro procedimiento.
    Resume mcblnSetToCreateField_Salida
   
End Function


06:26 GMT  |  Read comments(0)

Modificar una propiedad de un campo de una tabla en tiempo de ejecución
Sub demo_mcblnSetToModifyFieldProperty()
    Dim bytType             As Byte                     'Indicar el Tipo de datos al crear una tabla.
   
    Dim intSize             As Integer
   
    Dim strField            As String
    Dim strPathNamedbs      As String
    Dim strPWD              As String
    Dim strTable            As String
   
   
    strPathNamedbs = Application.CurrentProject.Path & "\dMcCrearTablas.mdb"
    strPWD = ""
   
    strTable = "tblPruebaAA"
   
    strField = "fldIdCampoAA"
    bytType = DAO.dbText
    intSize = 100
    Debug.Print mcblnSetToModifyFieldProperty(strPathNamedbs, strTable, strField, bytType, intSize, strPWD)
End Sub
Public Function mcblnSetToModifyFieldProperty(ByVal strPathNamedbs As String, _
                                              ByVal strTable As String, _
                                              ByVal strField As String, _
                                              ByVal bytType As Byte, _
                                              Optional ByVal intSize As Integer, _
                                              Optional ByVal strPWD As String) As Boolean
'------------------------------------------------------------------------------------------------------------------------
' Function      :   mcblnSetToModifyFieldProperty
' Title         :   Modificar una propiedad de un campo de una tabla en tiempo de ejecución.
' Creación      :   30/05/2007 10:42
' Autor         :   Copyright ©1999-2007 McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Propósito     :   Modificar una propiedad de un campo de una tabla ya existente. _
                    Código pensado y desarrollado para usar cuando se quiere actualizar la base de datos FrontEnd en _
                    una actualización al abrir la apps.
'------------------------------------------------------------------------------------------------------------------------
' Referencia/s  :   Nombre:     Microsoft DAO x.x Object Library
'                   Ruta:       C:\Archivos de programa\Archivos comunes\Microsoft Shared\DAO\daoxxx.dll
'------------------------------------------------------------------------------------------------------------------------
' Retorno       :   True / False, según se haya ejecutado el código con éxito o se haya producido un error.
'------------------------------------------------------------------------------------------------------------------------
'Argumento/s, la sintaxis del Procedimiento o Función consta de/los siguiente/s argumento/s:
'Parte              Descripción
'------------------------------------------------------------------------------------------------------------------------
'strPathNamedbs     Requerido   Ruta completa con nombre de la base de datos a crear la tabla.
'strTable           Requerido   Nombre de la tabla a modificar.
'strField           Requerido   Nombre del campo a modificar.
'bytType            Requerido   Determina el tipo de datos para la modificación del objeto Field. _
'intSize            Optional    Determina el tamaño del nuevo objeto Field que contenga texto. Si no se pasa será 255.
'strPWD             Optional    Contraseña de la dbs según strPathNamedbs.
'------------------------------------------------------------------------------------------------------------------------
  
    Dim dbs             As DAO.Database
   
    Dim strSql          As String
    Dim strType         As String
   
   
On Error GoTo mcblnSetToModifyFieldProperty_CapturarError
    If strPWD = "" Then
        Set dbs = OpenDatabase(strPathNamedbs, True, False)
    Else
        Set dbs = OpenDatabase(strPathNamedbs, True, False, ";PWD=" & strPWD)
    End If
   
    Select Case bytType
        Case DAO.dbByte
            strType = "BYTE"
        Case DAO.dbText
            strType = "TEXT" & "(" & intSize & ")"
        Case DAO.dbInteger
            strType = "INTEGER"
        Case DAO.dbMemo
            strType = "MEMO"
        'etc. etc.
       
        Case Else
            MsgBox "No se ha indicado un tipo de datos conocido.", vbCritical, "McPegasus informa"
    End Select
   
    If Not strType = "" Then
        'Ejemplo:   ALTER TABLE tblPruebaAA ALTER COLUMN fldIdCampoAA TEXT(100)
        strSql = "ALTER TABLE " & strTable & " ALTER COLUMN " & strField & " " & strType
        dbs.Execute strSql
        mcblnSetToModifyFieldProperty = True
    End If
   
mcblnSetToModifyFieldProperty_Salida:
       
    If Not dbs Is Nothing Then
        dbs.Close
        Set dbs = Nothing
    End If
   On Error GoTo 0
   Exit Function
mcblnSetToModifyFieldProperty_CapturarError:
    Select Case Err.Number
        Case Else
            'Cazar todos aquellos errores inesperados.
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure mcblnSetToModifyFieldProperty."
    End Select
    'Salida a otro procedimiento.
    Resume mcblnSetToModifyFieldProperty_Salida
   
End Function


06:00 GMT  |  Read comments(0)

Crear una tabla en tiempo de ejecución

Sub test_mcblnSetToCreateTable()
    Dim bytType             As Byte                     'Indicar el Tipo de datos al crear una tabla.
   
    Dim intSize             As Integer
   
    Dim strField            As String
    Dim strPathNamedbs      As String
    Dim strPWD              As String
    Dim strTable            As String
   
   
    strPathNamedbs = Application.CurrentProject.Path & "\dMcCrearTablas.mdb"
    strPWD = ""
   
    strTable = "tblPruebaAA"
   
    strField = "fldIdCampoAA"
    bytType = DAO.dbText
    intSize = 50
    'Para crear una tabla hay que crear como mínimo un campo.
    Debug.Print mcblnSetToCreateTable(strPathNamedbs, strTable, strField, bytType, intSize, strPWD)
End Sub
Public Function mcblnSetToCreateTable(ByVal strPathNamedbs As String, _
                                      ByVal strTable As String, _
                                      ByVal strField As String, _
                                      Optional bytType As Byte, _
                                      Optional ByVal intSize As Integer, _
                                      Optional ByVal strPWD As String) As Boolean
'------------------------------------------------------------------------------------------------------------------------
' Function      :   mcblnSetToCreateTable
' Title         :   Crear una tabla en tiempo de ejecución.
' Creación      :   30/05/2007 10:42
' Autor         :   Copyright ©1999-2007 McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Propósito     :   Crear una tabla. _
                    Código pensado y desarrollado para usar cuando se quiere actualizar la base de datos FrontEnd en _
                    una actualización al abrir la apps.
'------------------------------------------------------------------------------------------------------------------------
' Referencia/s  :   Nombre:     Microsoft DAO x.x Object Library
'                   Ruta:       C:\Archivos de programa\Archivos comunes\Microsoft Shared\DAO\daoxxx.dll
'------------------------------------------------------------------------------------------------------------------------
' Retorno       :   True / False, según se haya ejecutado el código con éxito o se haya producido un error.
'------------------------------------------------------------------------------------------------------------------------
'Argumento/s, la sintaxis del Procedimiento o Función consta de/los siguiente/s argumento/s:
'Parte              Descripción
'------------------------------------------------------------------------------------------------------------------------
'strPathNamedbs     Requerido   Ruta completa con nombre de la base de datos a crear la tabla.
'strTable           Requerido   Nombre de la tabla a crear.
'strField           Requerido   Nombre del primer campo a crear, es requerido para crear una tabla.
'bytType            Optional    Determina el tipo de datos para el nuevo objeto Field. Si no se pasa será dbText. _
'intSize            Optional    Determina el tamaño del nuevo objeto Field que contenga texto. Si no se pasa será 255.
'strPWD             Optional    Contraseña de la dbs según strPathNamedbs.
'------------------------------------------------------------------------------------------------------------------------
'Type (Propiedad), valores que se pueden establecer. Extracto de la ayuda de Access.
'   Constante       Valor   Descripción _
    dbBigInt        16      Big Integer,  Tipo de datos que almacena valores numéricos exactos con signo con una precisión 19 (con signo) o 20 (sin signo), escala 0 (con signo: -263 = n = 263-1; sin signo: 0 = n = 264-1). _
    dbBinary         9      Binary, Tipo de datos que almacena datos binarios de longitud fija. La longitud máxima es de 255 bytes. _
    dbBoolean        1      Boolean (Sí/No), Valor True/False o Sí/No. Los valores Boolean se almacenar normalmente en campos de tipo Bit de una base de datos Microsoft Jet. Sin embargo, algunas bases de datos no soportan este tipo de datos directamente. _
    dbByte           2      Byte, Tipo de datos fundamental utilizado para admitir números enteros positivos pequeños, en el intervalo de 0 a 255. _
    dbChar          18      Char, Tipo de datos que almacena una cadena de caracteres de longitud fija. La longitud se establece con la propiedad Size. _
    dbCurrency       5      Currency, Tipo de dato muy útil para los cálculos que incluyen dinero o cálculos de signo decimal fijo, en los que la exactitud es extremadamente importante. Este tipo de datos se utiliza para almacenar números de hasta 15 dígitos a la izquierda del signo decimal y 4 dígitos a la derecha. Dado que el tipo de datos Currency utiliza valores discretos para todas las cantidades, los redondeos binarios no son un factor cuando se calculan totales. _
    dbDate           8      Date / Time, Las fechas y horas se almacenan internamente como partes diferentes de un número real. _
                            El valor a la izquierda del signo decimal representa una fecha entre el 30 de diciembre de 1899 y el 30 de diciembre de 9999, ambos inclusive. Los valores negativos representas fechas anteriores al 30 de diciembre de 1899. _
                            El valor a la derecha del signo decimal representa una hora entre las 0:00:00 y las 23:59:59, ambas inclusive. El mediodía se representa por un .5. _
    dbDecimal       20      Decimal, Tipo de datos que almacena un valor numérico exacto con signo con una precisión p y una escala e (1 = p =15; 0 = e = p). _
    dbDouble         7      Double, Un tipo de dato fundamental que contiene números de signo flotante de doble precisión en formato IEEE. Una variable Double se almacena como un número de 64 bits (8 bytes) que varía entre -1.79769313486231E308 y -4.94065645841247E-324 para los valores negativos, desde 4.94065645841247E-324 a 1.79769313486231E308 para los valores positivos y 0. _
    dbFloat         21      Float, Tipo de datos que almacena un valor numérico aproximado con signo con una precisión de mantisa 15 (cero o valor absoluto de 10-308 a 10+308). _
    dbGUID          15      Guid, Identificador único global (Globally Unique Identifier/Universally Unique Identifier). Cadena de identificación única utilizada con las llamadas a procedimiento remotos. Cada interfaz y clase de objeto utiliza un GUID para su identificación. Un GUID es un valor de 128 bits de longitud. Por ejemplo, 12345678-1234-1234-1234-123456789ABC es un GUID con una sintaxis correcta. Los GUID del cliente y del servidor deben coincidir para que el cliente y el servidor se relacionen. Los vendedores de objetos OLE puede requerir que Microsoft reserve uno o más juegos de 256 GUID para su uso exclusivo. De forma alternativa, si tiene una tarjeta de red, puede ejecutar una herramienta llamada UUIDGEN.EXE, que le proporciona un conjunto de 256 GUID basados en la hora del día, la fecha y un número único contenido en su tarjeta de red. _
    dbInteger        3      Integer, Un tipo de datos fundamental que contiene números enteros. Una variable de tipo Integer se almacena como un número de 16 bits (2 bytes) de longitud, con un valor entre -32,768 y 32,767. _
    dbLong           4      Long, Tipo de datos fundamental que contiene valores de enteros largos. Una variable de tipo Long se almacena como un número de 32 bits de longitud (4 bytes) con un valor comprendido en el rango -2,147,483,648 a 2,147,483,647. _
    dbLongBinary    11      Long Binary (Objeto OLE). Ole Object, Tipo de datos de campo que se utiliza en objetos creados en otras aplicaciones que se pueden vincular e incrustar a una base de datos Microsoft Jet. Por ejemplo, puede utilizar un Objeto OLE para almacenar una colección de imágenes. _
    dbMemo          12      Memo, Tipo de datos de campo. Como los campos, puede contener hasta 1.2 GB de datos. _
    dbNumeric       19      Numeric, Tipo de datos que almacena un valor numérico exacto con signo con una precisión p y una escala e (1 = p =15; 0 = e = p). _
    dbSingle         6      Single, Tipo de datos fundamental que contiene un números de punto flotante de precisión simple en formato numérico IEEE. Una variable Single se almacena como un número de 32 bits de longitud (4 bytes) cuyo valor está comprendido entre -3.402823E38 y -1.401298E-45 para números negativo, entre 1.401298E-45 y 3.402823E38 si es positivo y 0. _
    dbText          10      Text, Tipo de datos de campo. Los campos de texto pueden contener hasta 255 caracteres o el número de caracteres especificado por la propiedad Size de objeto Field, siempre que sea menor. Si la propiedad Size del campo de texto está establecido a 0, el campo de texto puede contener hasta 255 caracteres de datos. _
    dbTime          22      Time, Tipo de datos que almacena un valor de hora. El valor depende del valor del reloj del origen de datos. _
    dbTimeStamp     23      TimeStamp, Tipo de datos que almacena una marca de hora. El valor depende del valor del reloj del origen de datos. _
    dbVarBinary     17      VarBinary, Tipo de datos que almacena datos binarios de longitud variable. La longitud máxima es de 255 bytes.
'------------------------------------------------------------------------------------------------------------------------
  
    Dim dbs             As DAO.Database
   
    Dim tdf             As DAO.TableDef
   
    Dim fld             As DAO.Field
   
    Dim bytMétodo       As Byte                     'Método a seleccionar para crear la tabla.
   
    Dim strSql          As String
    Dim strType         As String
   
   
On Error GoTo mcblnSetToCreateTable_CapturarError
    If strPWD = "" Then
        Set dbs = OpenDatabase(strPathNamedbs, True, False)
    Else
        Set dbs = OpenDatabase(strPathNamedbs, True, False, ";PWD=" & strPWD)
    End If
   
    For Each tdf In dbs.TableDefs
        If tdf.Name = strTable Then
            mcblnSetToCreateTable = True
            Exit For
        End If
    Next tdf
   
    If bytType = 0 Then
        bytType = DAO.dbText
    End If
   
    If Not mcblnSetToCreateTable Then
        bytMétodo = 4
        'Esta explicación de métodos es para que me quede constancia de las diferentes posibilidades que tenemos para _
        realizar la misma operación de crear una tabla, la finalidad es la misma pero en según que ocasiones nos puede _
        interesar sobre todo en no declarar los objetos.
   
        If bytMétodo = 1 Then
            'Este primer método nos permite no declarar ningún objeto ni como Database, ni Tabledef, ni Field, es un _
            modo de proceder directo.
'            OpenDatabase(strPathNamedbs, True, False).TableDefs(strTable).Fields.Append _
                    OpenDatabase(strPathNamedbs, True, False).TableDefs(strTable).CreateField(strField, bytType, intSize)
'            mcblnSetToCreateTable = True
        ElseIf bytMétodo = 2 Then
            'Si tenemos necesidad de declarar una variable como objeto Database, esta sentencia es más corta.
'            dbs.TableDefs(strTable).Fields.Append dbs.TableDefs(strTable).CreateField(strField, bytType, intSize)
'            mcblnSetToCreateTable = True
        ElseIf bytMétodo = 3 Then
            'Más corto este tercer método aunque se debe de hacer en dos líneas.
'            Set tdf = dbs.TableDefs(strTable)
'            tdf.Fields.Append tdf.CreateField(strField, bytType, intSize)                 'Crear el campo.
'            mcblnSetToCreateTable = True
        ElseIf bytMétodo = 4 Then
            'El método cuarto es el más estructurado aunque necesita declarar cada uno de los objeto.
            Set tdf = dbs.CreateTableDef(strTable)
            Set fld = tdf.CreateField(strField, bytType, intSize)
            tdf.Fields.Append fld
            dbs.TableDefs.Append tdf
            mcblnSetToCreateTable = True
        ElseIf bytMétodo = 5 Then
            'Método que usa una sentencia SQL y que no es necesario DAO salvo cuando la tabla a crear está fuera de la _
            que ejecuta este código.
            If intSize = 0 Then intSize = 255
            Select Case bytType
                Case DAO.dbByte
                    strType = "BYTE"
                Case DAO.dbText
                    strType = "TEXT" & "(" & intSize & ")"
                Case DAO.dbInteger
                    strType = "INTEGER"
                Case DAO.dbMemo
                    strType = "MEMO"
                'etc. etc.
                Case Else
                    MsgBox "No se ha indicado un tipo de datos conocido.", vbCritical, "McPegasus informa"
            End Select
            'Ejemplo:   CREATE TABLE tblPruebaAA (fldIdCampoAA TEXT(50))
            strSql = "CREATE TABLE " & strTable & " (" & strField & " " & strType & ")"
            dbs.Execute (strSql)
           
            'Método en caso de ejecutar en la propia dbs y sin DAO.
            'CodeDb.Execute (strSql)
           
            mcblnSetToCreateTable = True
        End If
    End If
mcblnSetToCreateTable_Salida:
    If Not fld Is Nothing Then
        Set fld = Nothing
    End If
   
    If Not tdf Is Nothing Then
        Set tdf = Nothing
    End If
       
    If Not dbs Is Nothing Then
        dbs.Close
        Set dbs = Nothing
    End If
   On Error GoTo 0
   Exit Function
mcblnSetToCreateTable_CapturarError:
    Select Case Err.Number
        Case Else
            'Cazar todos aquellos errores inesperados.
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure mcblnSetToCreateTable."
    End Select
    'Salida a otro procedimiento.
    Resume mcblnSetToCreateTable_Salida
   
End Function


05:55 GMT  |  Read comments(0)

23 May

Comprimir archivos generando un .cab
Option Compare Database
Option Explicit
'------------------------------------------------------------------------------------------------------------------------
' Módulo        :   basMcCompresiónCabXP
' Creación      :   23/05/2007 09:31
' Autor         :   Copyright ©1999-2007 McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Propósito     :   Con los recursos propios de Windows, conseguir en un archivo .cab creado desde cero y que contenga _
                    uno o varios archivos. _
                    Es posible incluir también un archivo que esté abierto, por ejemplo la propia base de datos que se _
                    está ejecutando el código.
' Qué hacer     :   Copiar todo el texto, crear un nuevo módulo en tu base de datos y pegar. _
                    Guardar con el nombre basMcCompresiónCabXP
'------------------------------------------------------------------------------------------------------------------------
'Documentación  :   Guille, http://www.elguille.info/vb/utilidades/MakeCab_TypeLibrary_w2000.htm _
                            http://www.elguille.info/vb/utilidades/MakeCabXP.htm
'------------------------------------------------------------------------------------------------------------------------
'Observaciones  :   Sólo crear archivos .cab, no hay utilidad de descompresión, para ello hay que usar una herramienta _
                    externa.
'------------------------------------------------------------------------------------------------------------------------
Sub test_mcblnComprimirArchivosCab()
    Dim strPathsFields          As String
   
    Dim strPathNameCab          As String
   
    strPathNameCab = "C:\Test.cab"
   
'    strPathsFields = "c:\Temp\Text01.txt;c:\Temp\Text02.txt"
    strPathsFields = CodeDb.Name
   
    If mcblnComprimirArchivosCab(strPathNameCab, strPathsFields) Then
        MsgBox "Se ha producido la compresión .cab con éxito.", vbInformation, "McPegasus informa"
    End If
End Sub
Public Function mcblnComprimirArchivosCab(ByVal strPathNameCab As String, ByVal strPathsNames As String) As Boolean
'------------------------------------------------------------------------------------------------------------------------
' Function      :   mcblnComprimirArchivosCab
' Creación      :   22/05/2007 16:45
' Autor         :   Copyright ©1999-2007 McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Origen        :   Adaptación de la idea original en http://www.mvp-access.com/emilio de Emilio Sancha, Gracias Emilio.
' Propósito     :   Comprimir uno o varios archivos a formato .zip con los recursos propios de Windows XP.
'------------------------------------------------------------------------------------------------------------------------
' Referencia/s  :   Nombre: COM MakeCab 1.0 Type Library
'                   Ruta:   c:\Windows\System32\catsrvut.dll
'------------------------------------------------------------------------------------------------------------------------
' Retorno       :   True / False, en caso de producirse la acción con éxito. False en caso de cualquier error.
'
'Argumento/s, la sintaxis del Procedimiento o Función consta de/los siguiente/s argumento/s:
'Parte              Descripción
'------------------------------------------------------------------------------------------------------------------------
'strPathNameCab     Requerido   Ruta y nombre completo con extensión .zip donde se creará el archivo destino.
'strPathsNames      Opcional    Cadena de texto donde establecer la ruta o rutas de los archivos a comprimir, separadas _
                                por ; en caso de haber más de una.
'------------------------------------------------------------------------------------------------------------------------
    Dim cab                     As COMMKCABLib.MakeCab
   
    Dim blnCopiar               As Boolean
   
    Dim intCount                As Integer
    Dim intPos                  As Integer
   
    Dim strArchivo              As String
    Dim strNombreDestino        As String           'Independizar el nombre destino del archivo a comprimir a .cab.
    Dim strNewPathName          As String           'En caso de estar abierto, copiarlo a Temp.
    Dim strWorkMatriz()         As String
   
   
On Error GoTo mcblnComprimirArchivosCab_CapturarError
    'Comprobar que la matriz no está vacía.
    If Not strPathsNames = "" Then
        Set cab = New COMMKCABLib.MakeCab
        cab.CreateCab strPathNameCab, False, 0, False
        strWorkMatriz = Split(strPathsNames, ";")
        For intCount = LBound(strWorkMatriz) To UBound(strWorkMatriz)
            strArchivo = strWorkMatriz(UBound(strWorkMatriz))
            strNombreDestino = Dir(strArchivo)
            'Comprobar si el/lo archivo/s está/n abierto/s, en ese caso crear una copia en Temp.
            If eshblnEstáAbiertoArchivo(strArchivo) Then
                'Copiar el archivo en la ruta Temp del sistema para copiarlo desde ese con extensión tmp.
                strNewPathName = Environ("TEMP") & "\" & IIf(InStr(1, Dir(strArchivo), ".") = 0, Dir(strArchivo), Mid(Dir(strArchivo), 1, InStr(1, Dir(strArchivo), ".") - 1) & ".tmp")
                blnCopiar = kbblnCopyFile(strArchivo, strNewPathName)
                If blnCopiar Then                       'En caso de true se ha realizado la copia con éxito.
                    'Establecer la nueva ruta para que se copie al archivo zip.
                    strWorkMatriz(intCount) = strNewPathName
                End If
            Else
                blnCopiar = True
            End If
            If blnCopiar Then
                'Copiar / introducir un archivo dentro del archivo .cab.
                cab.AddFile strWorkMatriz(intCount), strNombreDestino
                mcblnComprimirArchivosCab = True
                If Not strNewPathName = "" Then
                    'En caso de estar abierto el archivo, borrar la copia que se ha generado en Temp.
 'Lo ideal es poder borrar el archivo temporal, pero hay que hacer una pausa en el código hasta que se haya realizado _
 toda la copia por el método oShell. _
 En este caso del .cab, se ha podido enmascarar el archivo en Temp, con la extensión .tmp.
 '                  Kill (strNewPathName)
                End If
            End If
        Next intCount
        cab.CloseCab
    End If
   
Salida:
   Set cab = Nothing
   On Error GoTo 0
   Exit Function
mcblnComprimirArchivosCab_CapturarError:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure mcblnComprimirArchivosCab."
Resume
    Resume Salida                       'Salida a otro procedimiento.
End Function
Sub test_eshblnEstáAbiertoArchivo()
    Dim strPathNameCab          As String
   
    strPathNameCab = "c:\Temp\Prueba.Graficos.mdb"
    If eshblnEstáAbiertoArchivo(strPathNameCab) Then
        MsgBox "El archivo está abiero y usándose por otra aplicación.", vbInformation, "Mcpegasus informa"
    End If

End Sub
Private Function eshblnEstáAbiertoArchivo(ByVal strPathName As String) As Boolean
'------------------------------------------------------------------------------------------------------------------------
' Function      :   eshblnEstáAbiertoArchivo                    Forma parte de McMódulosVXXXX.mdb
' Creación      :   22/05/2007 15:00
' Autor         :   Copyright ©1999-2007 McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Origen        :   Idea original en http://www.mvp-access.com/emilio de Emilio Sancha, procedimiento EstaAbierto. _
                    ESH 07/04/05 10:15
' Propósito     :   Comprobar si un archivo está siendo usado por otra aplicación.
'------------------------------------------------------------------------------------------------------------------------
' Retorno       :   True / False, en caso de que el archivo está abierto o cerrado.
'
'Argumento/s, la sintaxis del Procedimiento o Función consta de/los siguiente/s argumento/s:
'Parte              Descripción
'------------------------------------------------------------------------------------------------------------------------
'strPathName    Requerido   Ruta y nombre del archivo a comprobar si está abierto y usándose por otro programa.
'------------------------------------------------------------------------------------------------------------------------
On Error GoTo eshblnEstáAbiertoArchivo_CapturarError
    Dim lngArchivo As Long
   
    lngArchivo = FreeFile
    'Intentar abrirlo con bloqueo de lectura y escritura, si falla, es porque ya está abierto.
    Open strPathName For Random Access Read Write Lock Read Write As lngArchivo
eshblnEstáAbiertoArchivo_Salida:
   Close lngArchivo
   On Error GoTo 0
   Exit Function
eshblnEstáAbiertoArchivo_CapturarError:
    Select Case Err.Number
        Case 70                         'Permiso denegado.
            'No hacer nada, filtrar el error ya que se retorna un valor True.
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure eshblnEstáAbiertoArchivo."
    End Select
    eshblnEstáAbiertoArchivo = True
    Resume eshblnEstáAbiertoArchivo_Salida
   
End Function
Sub demo_kbblnCopyFile()
    Dim strOrigen   As String
    Dim strDestino  As String
   
    strOrigen = "c:\Temp\Text02.txt"
    strDestino = "C:\Test.zip"
    If kbblnCopyFile(strOrigen, strDestino) Then
        MsgBox "Se ha realizado la copia del archivo con éxito.", vbInformation, "Mcpegasus informa"
    End If
End Sub
Private Function kbblnCopyFile(ByVal strPathNameFileOrigin As String, _
                               ByVal strPathNameFileDestination As String) As Boolean
'------------------------------------------------------------------------------------------------------------------------
' Function      :   kbblnCopyFile
' Creación      :   23/05/2007 10:22
' Autor         :   Copyright ©1999-2007 McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Origen        :   http://support.microsoft.com/kb/102671/es
' Propósito     :   Copiar un archivo de un lugar de disco a otra ruta diferente. La particularidad de este _
                    procedimiento es que puede copiar archivos abiertos, un problema habitual al intentar copiar la _
                    propia dbs que ejecuta el código. Hay una excepción que he encontrado y es que se produce el error _
                    70 Acceso denegado en caso de querer copiar una dbs que se está abriendo con Access desde otra _
                    versión posterior y sale el mensaje "Convertir o abrir base de datos".
'------------------------------------------------------------------------------------------------------------------------
' Retorno       :   True o False, según la copia se ha realizado con éxito o no.
'
'Argumento/s, la sintaxis del Procedimiento o Función consta de/los siguiente/s argumento/s:
'Parte                      Descripción
'------------------------------------------------------------------------------------------------------------------------
'strPathNameFileOrigin      Requerido   Ruta completa con el nombre del archivo origen que se va a copiar en otra lugar.
'strPathNameFileDestination Opcional    Ruta completa con el nombre del archivo destino.
'------------------------------------------------------------------------------------------------------------------------
   
    Const BlockSize = 32768
   
    Dim Index1          As Integer
    Dim NumBlocks       As Integer
    Dim SourceFile      As Integer
    Dim DestFile        As Integer
   
    Dim FileLength      As Long
    Dim LeftOver        As Long
    Dim FileData        As String
   
    On Error GoTo Err_kbblnCopyFile
    ' Remove the destination file.
    DestFile = FreeFile
    Open strPathNameFileDestination For Output As DestFile
    Close DestFile
    ' Open the source file to read from.
    SourceFile = FreeFile
    Open strPathNameFileOrigin For Binary Access Read As FreeFile
    ' Open the destination file to write to.
    DestFile = FreeFile
    Open strPathNameFileDestination For Binary As DestFile
    ' Get the length of the source file.
    FileLength = LOF(SourceFile)
    ' Calculate the number of blocks in the file and left over.
    NumBlocks = FileLength \ BlockSize
    LeftOver = FileLength Mod BlockSize
    ' Create a buffer for the leftover amount.
    FileData = String$(LeftOver, 32)
    ' Read and write the leftover amount.
    Get SourceFile, , FileData
    Put DestFile, , FileData
    ' Create a buffer for a block to be read.
    FileData = String$(BlockSize, 32)
    ' Read and write the remaining blocks of data.
    For Index1 = 1 To NumBlocks
       ' Read and write one block of data.
       Get SourceFile, , FileData
       Put DestFile, , FileData
    Next Index1
    Close SourceFile, DestFile
    kbblnCopyFile = True
Bye_kbblnCopyFile:
    Exit Function
Err_kbblnCopyFile:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure kbblnCopyFile."
    Debug.Print Err.Number & " " & Err.Description
    kbblnCopyFile = False
    Resume Bye_kbblnCopyFile
End Function
 


05:59 GMT  |  Read comments(0)

08 September

ODT, Office Develper Tools, Office Developer Edition, MOD, Microsoft Office Developer, ADE, Access Developer Extensions
 
Existe o existieron del Office distintas versiones, 2.0, 97, 2000, 2002 XP y 2003, en las que en cada paquete de Office (según composición) se incluye la aplicación llamada Access. En cada una de las versiones del Office generaron una herramienta para que un desarrollador (developer) pudiera crear paquetes instalables de una aplicación desarrollada en Access y que pudiera incluir también lo llamado RunTime.
 
Dicha herramienta es externa al propio Office y hay que adquirir por separado.

Microsoft para cada una de las versiones el dicho "creador de paquetes" lo han llamado de una manera,

    Access 2.0 = ODT, Office Developer Tools -a confirmar-

    Access 2000 = Microsoft Office 2000 Developer

    Access 97 = ODE, Office Developer Edition

    Access 2002 XP = MOD xp, Microsoft Office Developer

    Access 2003 = ADE, Access Developer Extensions .

Puede componerse de las siguientes herramientas dependiendo de la versión,
 
  • Package and Deployment Wizard, es un asistente que te ayuda a generar un instalable, en el puedes o no incluir el RunTime, el MSDE (Microsoft Data Engine). Consigues unos archivos Setup.exe, .cab, donde puedes crear un CD y usar para instalar la aplicación en otros equipos.
  • Access Runtime, es un producto que consta del permiso de usar los archivos necesarios para ejecutar Access en una máquina que no esté instalado. Tan solo puedes ejecutar, no editar ni crear bases de datos.
  • Visual SourceSafe Integration
  • WinAPI Viewer, un visualizador de librerías de API.
  • Code Librarina, librerías con código.
  • Replication Manager, un entorno para controlar las replicaciones de bases de datos que puedas tener dispersas por todo el mundo mundial.
  • Add-In Property Scanner (añadido de escáner de propiedad) para buscar a nivel global dentro de una solución Access 2003 una cadena concreta, y salte directamente al objeto en el que la cadena está localizada.
Extendiéndose un poco más con el Office 2003 que es el que está en vigor, se indica que ADE pertenece al paquete llamado Visual Studio Tools para Office, un conjunto de herramientas para desarrolladores. (Visual Studio Tools for Office System (VSTO))
 
Se puede descargar un documento de Hoja de producto con la documentación completa.
http://download.microsoft.com/download/5/c/e/5ceec328-2eb9-4269-8185-cddb9c7df61c/VSTO_datasheet_esp.doc
Se extrae lo más importante,
  • para utilizar Microsoft Office Access 2003 Developer Extensions debe disponer del producto ya instalados Microsoft Office Professional Edition 2003 o Microsoft Office Access 2003
  • ADE también incluye la licencia runtime de Access permitiendo así la distribución de soluciones basadas en Access 2003
 
Descargas relacionadas y más información,
 
Office XP Service Pack 3 (SP3) para Access 2002 Runtime

Información sobre el producto, http://www.microsoft.com/spanish/msdn/officexp/default.asp

 

Office XP Service Pack 3 (SP3) para Access 2002 Runtime
Descripción rápida: Office XP Service Pack 3 (SP3) para Access 2002 Runtime proporciona las actualizaciones más recientes a Access 2002 Runtime. Esta actualización contiene notables mejoras de seguridad, estabilidad y rendimiento.
 
Office Update
 
Problemas encontrados.
MOD xp.
 
Descripción del problema:
El error que se trata se produce al instalar un paquete generado con el Packaging Wizard de Office XP (2002) sobre un sistema operativo Windows Server 2003 o Windows XP con el SP2, no se produce sin mencionado Service Pack.
Título del error:
    Visual Basic 6.0 Setup Toolkit
 
Mensaje:
    Office System Pack no se puede instalar en este sistema. Necesita Windows NT 4.0 Service Pack 6 o posterior.
 
Solución:
Un saludo,

Rafael Andrada
Valencia [es]

..:: Tu Access, Mi Pasión ::..



07:26 GMT  |  Read comments(0)

26 August

... Microsoft Access no puede iniciarse porque en este equipo no hay licencia para usarlo...
Cuando quiero iniciar el programa Access 97 aparece el siguiente mensaje:  "Imposible iniciar Microsoft Access porque no hay licencia para el producto en este equipo".
Este problema está documentado por Microsoft en la KB con el Id. de artículo 191224,  http://support.microsoft.com/default.aspx?scid=kb;es-es;Q191224
 
En The Access Web proponen la siguiente solución (incluyen Access 95), http://www.mvps.org/access/bugs/bugs0013.htm

Para XP (2002) Microsoft en la Knowledge Base en el Id. de artículo 141373, http://support.microsoft.com/kb/141373/es

McPegasus

www.mcpegasus.es

mcpegasus@mcpegasus.es



01:55 GMT  |  Read comments(0)

31 July

Botones de desplazamineto personalizados.
Este ejemplo puede sustituir a los botones de desplazamiento que trae por defecto Access en los formularios.
 
Con esta personalización se tiene un subformulario con los botones de desplazamiento de registros personalizados y que se puede usar en varios formularios en la misma base de datos o proyecto, de este modo evitamos duplicidades.
 
Una característica es que añade un botón para borrar el registro, tal y como tiene el navegador del objeto Página de las versiones 2000 y superiores.
 
 
Licencia: mailware

Descargar archivo de ejemplo, McNavegador.TipoA.zip

 



05:42 GMT  |  Read comments(0)

26 July

Cambiar el estado de la ventana de Access, hacer invisible, maximizar, minimizar o restaurar.
'------------------------------------------------------------------------------------------------------------------------
' Módulo    : basHideOrShowAccessWindow
' Creación  : 26/07/2006 14:38
' Autor     : McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Qué hacer : Copiar todo el texto, crear un nuevo módulo en tu base de datos y pegar. Guardar con el nombre basHideOrShowAccessWindow
'------------------------------------------------------------------------------------------------------------------------
 
Option Compare Database
Option Explicit
 
    Dim lngReturn           As Long
 
    Public Const SW_HIDE           As Long = 0
    Public Const SW_SHOWNORMAL     As Long = 1
    Public Const SW_SHOWMINIMIZED  As Long = 2
    Public Const SW_SHOWMAXIMIZED  As Long = 3
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
 
Sub demo_mcblnEstadoAccessWindow_A()
    Dim strMensaje      As String
   
    Dim strRetVal       As String
   
    strMensaje = "El estado visible de la ventana de Access es: " & vbCr & vbCr
    strMensaje = strMensaje & "          " & mcblnEstadoAccessWindow(, True) & vbCr & vbCr & vbCr & vbCr
    strMensaje = strMensaje & "Seleccionar una opción para cambiarlo, " & vbCr & vbCr
    strMensaje = strMensaje & "0.- Hacer invisible la ventana de Access." & vbCr _
                            & "1.- Restaurar el tamaño." & vbCr _
                            & "2.- Minimizar." & vbCr _
                            & "3.- Maximizar."
    strRetVal = Nz(InputBox(strMensaje, "McPegasus informa.", 0))
    If Not strRetVal = "" Then
        Call mcblnEstadoAccessWindow(Int(strRetVal))
    End If
End Sub
 
Private Sub demo_mcblnEstadoAccessWindow_B()
    'Se puede usar esta llamada en el formulario de inicio de la aplicación y en su evento "Al abrir".
    Call mcblnEstadoAccessWindow(SW_HIDE)                       'Esconder la ventana.
'    Debug.Print mcblnEstadoAccessWindow(SW_SHOWMINIMIZED)      'Minimizar.
'    Debug.Print mcblnEstadoAccessWindow(SW_SHOWMAXIMIZED)      'Maximizar.
'    Debug.Print mcblnEstadoAccessWindow(SW_SHOWNORMAL)         'Tamaño restaurado.
End Sub
 
Public Function mcblnEstadoAccessWindow(Optional ByVal lngProcedure As Long, _
                                        Optional ByVal blnVerificarEstado As Boolean) As Boolean
'------------------------------------------------------------------------------------------------------------------------
' Function      :   mcblnEstadoAccessWindow                                             Forma parte de McMódulosV26k2.mdb
' Creación      :   27/01/2002
' Autor         :   McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Origen        :   Desconocido, adaptado de un código encontrado en la red.
' Propósito     :   Cambiar el estado de la ventana de Access, hacer invisible, maximizar, minimizar o restaurar.
'------------------------------------------------------------------------------------------------------------------------
' Actualizado   :   26/07/2006, Reestructuración y optimización del código, cambia el nombre de la función de _
                    fAccessWindow a el actual mcblnEstadoAccessWindow.
'------------------------------------------------------------------------------------------------------------------------
' Retorno       :   Si el valor de blnVerificarEstado es True, el retorno será el estado en el que está la ventana de _
                    Access es decir True para visible o False si está invisible.
'
'La sintaxis del Procedimiento o Función, consta de estos argumentos:
'Parte                  Descripción
'------------------------------------------------------------------------------------------------------------------------
'lngProcedure       Opcional    Para indicar el estado a cambiar de la ventana, según las constantes declaradas.
'blnVerificarEstado Opcional    Para conocer el estado actual de la ventana.

    If blnVerificarEstado Then
        mcblnEstadoAccessWindow = IIf(IsWindowVisible(hWndAccessApp) = 0, False, True)
    Else
        mcblnEstadoAccessWindow = ShowWindow(Application.hWndAccessApp, lngProcedure)
    End If
End Function
 
 


05:45 GMT  |  Read comments(0)

24 July

Sustituir una cadena por otra incluida.

Public Function mcstrSustituirCadena(ByVal intInicio As Integer, _
                                     ByVal strValor As String, _
                                     ByVal strValorASustituir As String, _
                                     ByVal strValorAInsertar As String, _
                                     Optional ByVal intVeces As Integer = 1) As String
'------------------------------------------------------------------------------------------------------------------------
' Function    : mcstrSustituirCadena                                                    Forma parte de McMódulosV26k2.mdb
' Creación    : 24/07/2006 13:16
' Autor       : McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Propósito   : Sustituir una cadena (strValorAInsertar) por otra (strValorASustituir) incluida en otra strValor.
'------------------------------------------------------------------------------------------------------------------------
' Retorno     : Una nueva cadena con los valores sustituidos.
'------------------------------------------------------------------------------------------------------------------------
'La sintaxis del Procedimiento o Función, consta de estos argumentos:
º 'Parte                          Descripción
'------------------------------------------------------------------------------------------------------------------------
'intInicio          Requerido   Posición inicial donde buscar.
'strValor           Requerido   Cadena donde está el valor a buscar y sustituir.
'strValorASustituir Requerido   Valor de la cadena a sustituir.
'strValorAInsertar  Requerido   Valor de la cadena que va a sustituir.
'intVeces           Opcional    Cantidad de veces a realizar la sustitución.

    Dim intPosición     As Integer
    Dim intCount        As Integer
   
    Dim strTemporal     As String

    intPosición = InStr(intInicio, strValor, strValorASustituir)
    Do While Not intPosición = 0
        If intVeces <= intCount Then
            intPosición = 0
        Else
            If Not intPosición = 0 Then
                strTemporal = Mid(strValor, intInicio, intPosición - 1)
                strTemporal = strTemporal & strValorAInsertar
                strTemporal = strTemporal & Mid(strValor, intPosición + Len(strValorASustituir))
                strValor = strTemporal
                intPosición = InStr(intInicio, strValor, strValorASustituir)
            End If
        End If
        intCount = intCount + 1
    Loop
   
    mcstrSustituirCadena = strValor
End Function

Sub demo_mcstrSustituirCadena()
    Dim intVeces                As Integer
    Dim strValor                As String
    Dim strValorASustituir      As String
    Dim strValorAInsertar       As String
   
    strValor = "Esto es una prueba de sustitución de texto y una prueba muy funcional prueba prueba."
'    strValor = "1.prueba 2.prueba 3.prueba 4.prueba"
    strValorASustituir = "prueba"
    strValorAInsertar = "demo"
    intVeces = 2
   
    Debug.Print mcstrSustituirCadena(1, strValor, strValorASustituir, strValorAInsertar, intVeces)
End Sub
 


04:31 GMT  |  Read comments(0)

18 July

Vincular una tabla o varias con igualdad del prefijo.
El ejemplo que se adjunta tiene una función que vincula una tabla según el nombre. En el caso de tener varias tablas con un prefijo homogéneo a todas ellas, con pasar dicho prefijo será suficiente para vincularlas.
 
'------------------------------------------------------------------------------------------------------------------------
' Function    : mcblnVincularTabla,
' Creación    : 02/01/2006 10:54
' Autor       : McPegasus, www.mcpegasus.es, mcpegasus@mcpegasus.es
' Propósito   : Vincular una tabla o varias tablas en caso de existir un prefijo homogéneo en los nombres.
'------------------------------------------------------------------------------------------------------------------------
' Actualizado : 02/01/2006, Breve Descripción sobre la actualización.
'------------------------------------------------------------------------------------------------------------------------
' Retorno     : True, si se ha producido la vinculación o vinculaciones correctamente. _
                False, si se ha producido algún error.
'
'La sintaxis del Procedimiento o Función, consta de estos argumentos:
'Parte                          Descripción
'------------------------------------------------------------------------------------------------------------------------
'strRutaOrigen      Requerido.  Ruta de la db donde está la tabla original y que va a ser vinculada.
'strRutaDestino     Requerido.  Ruta de la db donde se vinculará la tabla o tablas.
'strPrefijoTabla    Opcional    En el caso de que en la db origen hay una sola tabla con un prefijo determinado, _
                                la función buscará y vinculará todas las tablas con dicho prefijo. En caso de no _
                                encontrar y strNombreTabla tiene valor se vinculará esta última.
'strNombreTabla     Opcional    Nombre de la tabla a vincular.
 
 
Licencia: mailware

Descargar archivo de ejemplo, McVincularTablas.10K2

 



02:29 GMT  |  Read comments(0)

14 July

Esc, pulsar la tecla ESC y cerrar el formulario.
Si se tiene la necesidad de cerrar el formulario pulsando la tecla Esc, podemos conseguirlo con las instrucciones siguientes,
  • El formulario tiene un evento llamado "Al presionar una tecla", crear su [Procedimiento de evento] haciendo doble clic sobre ella. (Estamos situado en la ventana de propiedades del formulario).
  • Copy & Paste del siguiente código

Private Sub Form_KeyPress(KeyAscii As Integer)

    If KeyAscii = vbKeyEscape Then
        DoCmd.Close acForm, Me.Name
    End If

End Sub

  • Grabar los cambios y ejecutar el formulario, pulsar la tecla Esc.

McPegasus

www.mcpegasus.es

mcpegasus@mcpegasus.es

04:22 GMT  |  Read comments(0)

Fechas, automatizar la entrada.

Con este código conseguimos simplificar la entrada de una fecha tal como podemos conseguir con Excel que al poner por ejemplo 10/05 en una celda conseguimos que nos ponga el año o depende del formato que tenga la celda.
 
En caso de tener el formato dd/mm/aaaa y al poner 21/04 en una celda, obtenemos 21/04/2006, ha añadido el año que tenga el sistema.
 
Rizando el rizo y con la intención de mejorar la calidad del usuario que usa la aplicación, con McFechas.AutomatizarEntradas obtenemos el código de ejemplo para la conversión al introducir los datos siguientes,

Si ponemos un 1 obtenemos automáticamente --> 01/07/2006

En caso de un 31 --> 31/07/2006

35 --> 03/05/2006

245 --> 24/05/2006

282 --> 28/02/2006

292 --> Con la intención de obtener 29/02/2006, sale un mensaje que indica, El valor '292' que introdujo no corresponde a ninguna fecha válida

Estos ejemplos se han ejecutado en el mes de Julio y en el 2006, por eso se obtienen los valores 07/2006 donde corresponda.

 

Licencia: mailware

Descargar archivo de ejemplo, McFechas.AutomatizarEntrada

Última modificación: 25/07/2006

 

McPegasus

www.mcpegasus.es

mcpegasus@mcpegasus.es

 

 

 

 

 


02:37 GMT  |  Read comments(0)

04 July

Visualizador de archivos Snapshot

Microsoft Snapshot Viewer 10.0 El Visor de instantáneas Snapshot Viewer le permite ver una instantánea de informe sin tener el estándar de
versiones en tiempo de ejecución de Microsoft Access 97, Access 2000, o Access 2002.

 

Centro de descarga de Microsoft



15:18 GMT  |  Read comments(0)

Uno de los problemas que me encuentro es a la hora de diseñar formatos de albaranes, facturas desde access. No hay forma de poner una línea a lo largo de todo el detalle
'Copiar y pegar este código detrás del informe.
 

Private Sub Report_Page()
'Al paginar
 
'Reply-To: "Eduardo Olaz" <eduardo@olaz.net>
'From: "Eduardo Olaz" <eduardo@olaz.net>
'Subject: Re: Informes más profesionales
'Newsgroups: microsoft.public.es.Access
 
        Const conIzquierda As Long = 50
        Const conDerecha As Long = 9000
        Const conArriba As Long = 100
        Const conAbajo As Long = 12000
        Const conEstrecho As Long = 1
        Const conAncho As Long = 50
        Const conLineas As Long = 40
 
        Dim i As Long
        Dim Y As Long
        Dim X As Long
        Dim lngIncremento As Long
 
        lngIncremento = (conAbajo - conArriba) / conLineas
 
        DrawWidth = conEstrecho
        Line (conIzquierda, conArriba)-(conIzquierda, conAbajo)
        DrawWidth = conAncho
        Line (conIzquierda, conAbajo)-(conDerecha, conAbajo)
        DrawWidth = conEstrecho
        Line (conDerecha, conAbajo)-(conDerecha, conArriba)
        DrawWidth = conAncho
        Line (conDerecha, conArriba)-(conIzquierda, conArriba)
 
        DrawWidth = conEstrecho
        For i = 1 To conLineas - 1
            Y = conArriba + i * lngIncremento
            Line (conIzquierda, Y)-(conDerecha, Y)
        Next i
        X = conIzquierda + (conDerecha - conIzquierda) / 8
        Line (X, conArriba)-(X, conAbajo)
        X = conIzquierda + (conDerecha - conIzquierda) / 2
        Line (X, conArriba)-(X, conAbajo)
        X = conDerecha - (conDerecha - conIzquierda) / 4
        Line (X, conArriba)-(X, conAbajo)
        DrawWidth = conAncho / 2
        'También se puede dibujar un rectángulo con la opción B
        Line (conIzquierda, conAbajo + 500)-(conDerecha, conAbajo + 1000), , B
       
End Sub


15:07 GMT  |  Read comments(0)

Quitar las barras de título tanto de la ventana principal del Access cómo de los formularios.
'Crea un módulo nuevo y pega este código. Nombre: basQuitarBarraTitulos

Option Compare Database
Option Explicit

Const NombreModulo = "basFormGlobal"

' Store rectangle coordinates.
Type adhTypeRect
    X1 As Long
    Y1 As Long
    x2 As Long
    Y2 As Long
End Type

Declare Function adh_apiIsIconic Lib "user32" _
        Alias "IsIconic" (ByVal hWnd As Long) As Long

Declare Function adh_apiGetDeviceCaps Lib "gdi32" _
        Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Declare Function adh_apiGetWindowRect Lib "user32" _
        Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As adhTypeRect) As Long

Declare Function adh_apiGetParent Lib "user32" _
        Alias "GetParent" (ByVal hWnd As Long) As Long

Declare Function adh_apiGetClientRect Lib "user32" _
        Alias "GetClientRect" (ByVal hWnd As Long, lpRect As adhTypeRect) As Long

Declare Function adh_apiGetWindowLong Lib "user32" _
        Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Declare Function adh_apiGetSystemMetrics Lib "user32" _
        Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Declare Function adh_apiGetActiveWindow Lib "user32" _
        Alias "GetActiveWindow" () As Long

'=======================================================================

' Store group/subform dimensions.
Type adhTypeDimensions
    sglLeft As Double
    sglTop As Double
    sglWidth As Double
    sglHeight As Double
    strCtlName As String
End Type

' These are the class names used in Access.
Public Const adhcAccessClass = "OMain"
Public Const adhcMDIClientClass = "MDICLIENT"
Public Const adhcAccessDBCClass = "ODb"
Public Const adhcAccessFormClass = "OForm"

' Windows API declarations.
Declare Function adh_apiCreateIC Lib "gdi32" _
        Alias "CreateICA" (ByVal lpDriverName As String, _
        ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long

Declare Function adh_apiDeleteDC Lib "gdi32" _
        Alias "DeleteDC" (ByVal hdc As Long) As Long

Declare Function adh_apiMoveWindow Lib "user32" _
        Alias "MoveWindow" (ByVal hWnd As Long, _
        ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, _
        ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Declare Function adh_apiSetWindowLong Lib "user32" _
        Alias "SetWindowLongA" (ByVal hWnd As Long, _
        ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function adh_apiGetWindow Lib "user32" _
        Alias "GetWindow" (ByVal hWnd As Long, ByVal wCmd As Long) As Long

Declare Function adh_apiGetClassName Lib "user32" _
        Alias "GetClassNameA" (ByVal hWnd As Long, _
        ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Declare Function adh_apiFindWindow Lib "user32" _
        Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long

Declare Function adh_apiGetNextWindow Lib "user32" _
        Alias "GetNextWindow" (ByVal hWnd As Long, ByVal wFlag As Long) As Long

Declare Function adh_apiSetFocus Lib "user32" _
        Alias "SetFocus" (ByVal hWnd As Long) As Long

' Get a string from a private INI file.  Returns the number of bytes
' copied into strReturned, not including the trailing null.
Declare Function adh_apiGetPrivateProfileString Lib "kernel32" _
        Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As String, ByVal lpDefault As String, _
        ByVal lpReturnedString As String, ByVal nSize As Long, _
        ByVal lpFileName As String) As Long

' Write a string to a private INI file.  Returns a non-zero value if successful,
' otherwise it returns a 0.
Declare Function adh_apiWritePrivateProfileString Lib "kernel32" _
        Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As String, ByVal lpString As String, _
        ByVal lpFileName As String) As Long

' These functions aren't actually used
' but are provided here for reference only.

' Get a string from WIN.INI. Returns the number of bytes copied into strReturned,
' not including the trailing null.
Declare Function adh_apiGetProfileString Lib "kernel32" _
        Alias "GetProfileStringA" (ByVal lpadhcAppName As String, _
        ByVal lpKeyName As String, ByVal lpDefault As String, _
        ByVal lpReturnedString As String, ByVal nSize As Long) As Long

' Get an integer from WIN.INI.  Returns either the integer it found,
' or the value sent in intDefault.
Declare Function adh_apiGetProfileInt Lib "kernel32" _
        Alias "GetProfileIntA" (ByVal lpadhcAppName As String, _
        ByVal lpKeyName As String, ByVal nDefault