Cómo implementar un proyecto de Access 2002 que incluye Microsoft SQL Server 2000 Desktop Engine

Microsoft SQL Server 2000 Desktop Engine (MSDE 2000) es un servidor de almacenamiento de datos compatible con SQL Server 2000 que se incluye con Microsoft Office XP Developer, con derechos para redistribuir. El Asistente de empaquetado de Office XP Developer tiene una opción para incluir SQL Server 2000 Desktop Engine al empaquetar un proyecto de Microsoft Access (* .adp) solución. Cuando se instala la solución en el equipo de un usuario, SQL Server 2000 Desktop Engine se instala junto con la solución. Sin embargo, no se inicia SQL Server 2000 Desktop Engine y la base de datos no está conectado a SQL Server 2000 Desktop Engine.

Nota : la versión anterior de Microsoft SQL Server 2000 Desktop Engine se denomina Data Engine (MSDE).

En este artículo proporciona el código que se debe utilizar para encontrar el servidor para iniciar el servidor si no se inicia ya, para adjuntar la base de datos al servidor y para conectar el proyecto a la base de datos recién adjunto. El código es específico para utilizar en un proyecto. Sin embargo, gran parte del código puede utilizarse cualquier Visual Basic para aplicaciones (VBA) de aplicación.

Microsoft proporciona ejemplos de programación con fines ilustrativos únicamente, sin ninguna garantía tanto expresa como implícita. Esto incluye, entre otras, las garantías implícitas de comerciabilidad e idoneidad para un fin determinado. Este artículo se supone que está familiarizado con el lenguaje de programación que se muestra y con las herramientas que se utilizan para crear y depurar procedimientos. Los ingenieros de soporte técnico de Microsoft pueden explicarle la funcionalidad de un determinado procedimiento, pero no modificarán estos ejemplos para ofrecer mayor funcionalidad ni crearán procedimientos que cumplan sus requisitos específicos.

Pasos para modificar un proyecto aplicación para implementación

En los pasos siguientes supone que ya tiene un funciona correctamente el proyecto de aplicación que está preparado para implementar. Los pasos le guiarán por cómo agregar código adicional a su proyecto de VBA, cómo realizar los ajustes necesarios al formulario de inicio y cómo crear un paquete de implementación para un proyecto existente de Microsoft Access (* .adp) que incluye Microsoft SQL Server 2000 Desktop Engine.

1. Abra el proyecto de Access que desee implementar y a continuación, cree un nuevo módulo.
   
   Dado que el código que se va a incluir utiliza código SQLDMO y secuencias de comandos, debe asegurarse de que las referencias necesarias están presentes.
2. En el menú Herramientas del Editor de Visual Basic, haga clic en referencias .
3. En el cuadro de diálogo referencias , haga clic para seleccionar el siguiente si no están ya activadas:
   • Biblioteca de objetos Microsoft SQLDMO
   • Microsoft Scripting Runtime
4. Haga clic en Aceptar para cerrar el cuadro de diálogo referencias .
5. Copie el código siguiente al nuevo módulo:

   Option Compare Database
   Option Explicit
   Dim adp_UseIntegratedSecurity As Boolean
   
   
   Public Function fStartUp(strDBName As String, strMDFName As String, _
           Optional strUN As String, Optional strPW As String)
   '------------------------------------------------------------
   'The code in this project connects the MDF file
   'to a local MSDE, then establishes the connection between
   'the Access Project and MSDE.
   '------------------------------------------------------------
       Dim strSQLInstances As String
       Dim strServername As String
       Dim intInst As Integer
       Dim strMachineName As String
       Dim spaceLocation As Long
       
   'If no username is supplied, and you cannot 
   'use integrated security, the function requires that you provide a valid SQL Server user account and password.
       
       If Not fCheckForCompatibleOS Then
           strMachineName = "(local)"
               If strUN = "" Then
                  MsgBox "Provide a valid SQL Server user account and password to log on to SQL Server because the current operating system does not support integrated security."
                  Exit Function
               End If
              adp_UseIntegratedSecurity = False
       Else
           strMachineName = ComputerName
           If strUN = "" Then
               adp_UseIntegratedSecurity = True
           Else
               adp_UseIntegratedSecurity = False
           End If
       End If
   
       'Find the available instances of SQL 2000 on the computer.
       intInst = GetValidSQLInstances(strSQLInstances)
       If intInst < 1 Then
           Dim strErrorMsg As String
           strErrorMsg = "This application requires SQL Server 2000 " & _
               "to be installed on the local computer."
           MsgBox strErrorMsg, vbCritical, "SQL Server 2000 not installed!"
           Exit Function
       End If
       'At this point, it has been determined that there is at
       'least one valid SQL Server 2000 instance on the computer.
       'The code below picks the default or first instance if more than
       'one is available. You may want to add code to prompt the user for
       'a choice when there is more than one instance on the computer.
       
       If InStr(1, strSQLInstances, "MSSQLSERVER") Then
           strServername = strMachineName
       Else
           spaceLocation = InStr(1, strSQLInstances, " ")
           If spaceLocation = 0 Then
               strServername = strMachineName & "\" & strSQLInstances
           Else
               strServername = strMachineName & "\" & Mid(strSQLInstances, 1, spaceLocation)
           End If
       End If
       
       'Call fstartMSDE to connect to SQL Server
       fStartMSDE strServername, strUN, strPW
       
       'Call sCopyMDF to move the data file to the data folder
       'of SQL Server, and then attach it to the server.
       fCopyMDF strServername, strUN, strPW, strDBName, strMDFName
       
       'Connect the ADP to the new database
       fChangeADPConnection strServername, strDBName, strUN, strPW
   
   
   End Function
   
   Public Function fStartMSDE(strServername As String, _
                   Optional strUN As String, Optional strPW As String)
   '------------------------------------------------------------
   'This subroutine will turn on MSDE. If the server has been
   'started, the error trap will exit the function leaving the
   'server running.
   '
   'Note that it will not put the SQL Service Manager on
   'the start bar.
   '
   'Input:
   '   strServername    The server to be started
   '   strUN        The user used to start server
   '   strPW        The password of user
   '
   'Output:
   '   Resolution of start
   '
   'References:
   '   SQLDMO
   '------------------------------------------------------------
   
       Dim osvr As SQLDMO.SQLServer
       Set osvr = CreateObject("SQLDMO.SQLServer")
           
       On Error GoTo StartError 'Error Trap
       osvr.LoginTimeout = 60
       osvr.LoginSecure = adp_UseIntegratedSecurity
       osvr.Start True, strServername, strUN, strPW
   
   ExitSub:
       Set osvr = Nothing
       Exit Function
   
   StartError:
       If Err.Number = -2147023840 Then
       'This error is thrown when the server is already running,
       'and Server.Start is executed on Windows NT, 2000, or XP.
          
           osvr.Connect strServername, strUN, strPW  'Connect to Server
           
           Else 'Unknown Error
           MsgBox Err.Number & ": " & Err.Description
       End If
       Resume ExitSub
   End Function
   
   
   Public Function fCopyMDF(strServername As String, _
                   strUN As String, strPW As String, _
                   strDBName As String, _
                   sMDFName As String)
   
   '------------------------------------------------------------
   'This Function determines whether the database is already on
   'the MSDE Server. If the database does not exist, this
   'function copies the MDF file from the same location as the
   'ADP to MSDE's Data directory and then attaches the database.
   '
   'Input:
   '   strServername 	The server to be started
   '   strUN        	The user used to start server
   '   strPW 		The password of user
   '   strDBName 		The Name of the SQL Database
   '   sMDFName 		The Name of the MSDE Database to be copied
   '
   'Output:
   '   Resolution of copy
   '
   'References:
   '   SQLDMO
   '   Scripting Runtime
   '------------------------------------------------------------
   
   Dim FSO As Scripting.FileSystemObject
   Dim osvr As SQLDMO.SQLServer
   Dim strMessage As String
   Dim db As Variant
   Dim fDataBaseFlag As Boolean
   Dim dbCount As Integer
   
   On Error GoTo sCopyMDFTrap
   
       'The drive names used in FSO.Copyfile and
       'oSvr.AttachDBWithSingleFile must match the
       'locations for Program Files and MSDE on the
       'computer of the end user.
   
       fCopyMDF = ""
       fDataBaseFlag = False
       Set FSO = CreateObject("Scripting.FileSystemObject")
       Set osvr = CreateObject("SQLDMO.SQLServer")
       osvr.LoginSecure = adp_UseIntegratedSecurity
       osvr.Connect strServername, strUN, strPW
       dbCount = osvr.Databases.Count
       
       'Look for database existence on Local MSDE Server
       'by looping through all database names on the local
       'MSDE Server.
       For Each db In osvr.Databases
       
           If db.Name = strDBName Then 'The database exists
               fDataBaseFlag = True
               Exit For 'Get out of loop
           End If
     
       Next
       
       If Not fDataBaseFlag Then 'There is no database
                                 'matching sDBName
   
           'Copy File to data folder.
           FSO.CopyFile Application.CurrentProject.Path _
           & "\" & sMDFName, _
           osvr.Databases("master").PrimaryFilePath & _
           sMDFName, True
   
           'Attach to database.
           strMessage = osvr.AttachDBWithSingleFile(strDBName, _
               osvr.Databases("master").PrimaryFilePath _
               & sMDFName)
       End If
        
   ExitCopyMDF:
       osvr.Disconnect
       Set osvr = Nothing
   Exit Function
       
   sCopyMDFTrap:
   
       If Err.Number = -2147216399 Then 'DMO must be initialized
           Resume Next
       Else
           MsgBox Err.Description
       End If
       
       Resume ExitCopyMDF
   Exit Function
       
   End Function
   
   
   Function MakeADPConnectionless()
   '------------------------------------------------------------
   'This code removes the connection properties from the
   'Access Project for troubleshooting purposes.
   'The ADP will open in a disconnected state until new connection
   'properties are supplied.
   '------------------------------------------------------------
       Application.CurrentProject.OpenConnection ""
   End Function
    
   Function fChangeADPConnection(strServername, strDBName As String, Optional strUN As String, _
           Optional strPW As String) As Boolean
   '------------------------------------------------------------
   'This Function resets the connection for an ADP by using the
   'input parameters to create a new connection string. If no username
   'is supplied, it tries to connect by using integrated security.
   '
   'Input:
   '   strServerName    The server to be started
   '   strDBName   The Name of the MSDE Database
   '   strUN        The user used to start server
   '   strPW        The password of user
   '------------------------------------------------------------
       Dim strConnect As String
       On Error GoTo EH:
       strConnect = "Provider=SQLOLEDB.1" & _
       ";Data Source=" & strServername & _
       ";Initial Catalog=" & strDBName
       If adp_UseIntegratedSecurity Then
           strConnect = strConnect & ";integrated security=SSPI"
       Else
           strConnect = strConnect & ";user id=" & strUN
           strConnect = strConnect & ";password=" & strPW
       End If
       Application.CurrentProject.OpenConnection strConnect
       fChangeADPConnection = True
       Exit Function
   EH:
       MsgBox Err.Number & ": " & Err.Description, vbCritical, "Connection Error"
       fChangeADPConnection = False
   End Function
   					

6. Guardar este módulo como modCopyConnect .
7. Cree un módulo segundo y, a continuación, copie el código siguiente en el segundo módulo:

   Option Compare Database
   Option Explicit
   
   'This module provides functions that work together to
   'find existing computers running SQL Servers, and also the computer name.
         
   Public Type OSVERSIONINFO
       dwOSVersionInfoSize As Long
       dwMajorVersion As Long
       dwMinorVersion As Long
       dwBuildNumber As Long
       dwPlatformId As Long
       szCSDVersion As String * 128
   End Type
   
   Declare Function GetVersionExA Lib "kernel32" _
            (lpVersionInformation As OSVERSIONINFO) As Integer
   
   Private Declare Function OSRegOpenKey Lib "advapi32" Alias _
   "RegOpenKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, _
   phkResult As Long) As Long
   
   Private Declare Function OSRegQueryValueEx Lib "advapi32" _
   Alias "RegQueryValueExA" (ByVal hKey As Long, _
   ByVal lpszValueName As String, ByVal dwReserved As Long, _
   lpdwType As Long, lpbData As Any, cbData As Long) As Long
   
   Private Declare Function GetComputerName _
   Lib "kernel32" Alias _
   "GetComputerNameA" (ByVal lpBuffer As String, _
   nSize As Long) As Long
   
   Private Declare Function OSRegCloseKey Lib "advapi32" _
   Alias "RegCloseKey" (ByVal hKey As Long) As Long
   
   Private Const MAX_COMPUTERNAME_LENGTH As Long = 15&
   Public Const HKEY_CLASSES_ROOT = &H80000000
   Public Const HKEY_CURRENT_USER = &H80000001
   Public Const HKEY_LOCAL_MACHINE = &H80000002
   Public Const HKEY_USERS = &H80000003
   Private Const ERROR_SUCCESS = 0&
   Private Const VER_PLATFORM_WIN32s = 0  'Win32s on Windows 3.1
   Private Const VER_PLATFORM_WIN32_WINDOWS = 1  'Windows 95/98/ME.
   Private Const VER_PLATFORM_WIN32_NT = 2  'Windows NT/2000/XP
   Private Const REG_SZ = 1
   Private Const REG_BINARY = 3
   Private Const REG_DWORD = 4
   Private Const REG_MULTI_SZ = 7
   
   
   Public Function GetValidSQLInstances(ByRef strSQLInstances _
                   As String) As Integer
   '-----------------------------------------------------------
   ' This returns number of valid SQL instances and a space
   ' delimited string that lists the instances.
   '-----------------------------------------------------------
   
       Dim hKey As Long, i As Integer
       Dim strVersionInfo As String
       strSQLInstances = ""
       GetValidSQLInstances = 0
       
       If RegOpenKey(HKEY_LOCAL_MACHINE, _
       "Software\Microsoft\Microsoft SQL Server", hKey) Then
           RegQueryStringValue hKey, "InstalledInstances", strSQLInstances
           RegCloseKey hKey
           StrConv strSQLInstances, vbUpperCase
           If InStr(1, strSQLInstances, "MSSQLSERVER") Then
              If RegOpenKey(HKEY_LOCAL_MACHINE, _
              "Software\Microsoft\MSSQLServer\MSSQLServer\CurrentVersion", _
              hKey) Then
                   RegQueryStringValue hKey, "CurrentVersion", strVersionInfo
                   RegCloseKey hKey
                   If Mid(strVersionInfo, 1, 1) <> 8 Then
                       Replace strSQLInstances, "MSSQLSERVER", ""
                   End If
               End If
           End If
           Trim strSQLInstances
           If Len(strSQLInstances) > 0 Then
               GetValidSQLInstances = GetValidSQLInstances + 1
           Else
               Exit Function
           End If
           For i = 1 To Len(strSQLInstances)
               If Mid$(strSQLInstances, i, 1) = " " Then
                   GetValidSQLInstances = GetValidSQLInstances + 1
               End If
           Next i
       End If
   End Function
   
   
   Public Function RegOpenKey(ByVal hKey As Long, _
   ByVal lpszSubKey As String, phkResult As Long) As Boolean
   '-----------------------------------------------------------
   ' FUNCTION: RegOpenKey
   ' Opens an existing key in the system registry.
   ' Returns: True, if the key opened successfully. False
   ' otherwise.
   ' Upon success, phkResult is set to the handle of the key.
   '-----------------------------------------------------------
       Dim lResult As Long
       Dim strHkey As String
   
       strHkey = strGetHKEYString(hKey)
   
       lResult = OSRegOpenKey(hKey, lpszSubKey, phkResult)
       If lResult = ERROR_SUCCESS Then
           RegOpenKey = True
       End If
   End Function
   
   
   Public Function RegCloseKey(ByVal hKey As Long) As Boolean
       Dim lResult As Long
   '-----------------------------------------------------------
   ' FUNCTION: RegCloseKey
   ' Closes an open registry key.
   ' Returns: True on success, else False.
   '-----------------------------------------------------------
       lResult = OSRegCloseKey(hKey)
       RegCloseKey = (lResult = ERROR_SUCCESS)
   End Function
   
   
   Private Function strGetHKEYString(ByVal hKey As Long) As String
   '-----------------------------------------------------------
   'Given an HKEY, return the text string representing that key.
   '-----------------------------------------------------------
       Dim strKey As String
       Dim intIdx As Integer
       strKey = strGetPredefinedHKEYString(hKey)
       If Len(strKey) > 0 Then
           strGetHKEYString = strKey
           Exit Function
       End If
    End Function
   
   
   Private Function strGetPredefinedHKEYString(ByVal _
   hKey As Long) As String
   '-----------------------------------------------------------
   'Given a predefined HKEY, return the text string representing
   'that key, or else return vbNullString.
   '-----------------------------------------------------------
       Select Case hKey
           Case HKEY_CLASSES_ROOT
               strGetPredefinedHKEYString = "HKEY_CLASSES_ROOT"
           Case HKEY_CURRENT_USER
               strGetPredefinedHKEYString = "HKEY_CURRENT_USER"
           Case HKEY_LOCAL_MACHINE
               strGetPredefinedHKEYString = "HKEY_LOCAL_MACHINE"
           Case HKEY_USERS
               strGetPredefinedHKEYString = "HKEY_USERS"
       End Select
   End Function
   
   
   Public Function RegQueryStringValue(ByVal hKey As Long, _
   ByVal strValueName As String, strData As String) As Boolean
   '-----------------------------------------------------------
   ' Retrieves the string data for a named
   ' (strValueName = name) or unnamed (Len(strValueName) = 0)
   ' value in a registry key. If the named value
   ' exists, but its data is not a string, this function
   ' fails.
   '
   ' Returns: True on success, else False.
   '   On success, strData is set to the string data value.
   '-----------------------------------------------------------
       Dim lResult As Long
       Dim lValueType As Long
       Dim strBuf As String
       Dim lDataBufSize As Long
       lResult = OSRegQueryValueEx(hKey, strValueName, 0&, _
                 lValueType, _
           ByVal 0&, lDataBufSize)
       If lResult = ERROR_SUCCESS Then
           If lValueType = REG_SZ Then
               strBuf = space$(lDataBufSize)
               lResult = OSRegQueryValueEx(hKey, strValueName, 0&, _
                    0&, ByVal strBuf, lDataBufSize)
               If lResult = ERROR_SUCCESS Then
                   RegQueryStringValue = True
                   strData = StringFromBuffer(strBuf)
               End If
                   ElseIf lValueType = REG_MULTI_SZ Then
               strBuf = space$(lDataBufSize)
               lResult = OSRegQueryValueEx(hKey, strValueName, 0&, _
                         0&, _
                   ByVal strBuf, lDataBufSize)
               If lResult = ERROR_SUCCESS Then
                   RegQueryStringValue = True
                   strData = ReplaceNullsWithSpaces(strBuf)
               End If
           End If
       End If
   End Function
   
   
   Public Function StringFromBuffer(Buffer As String) As String
       Dim nPos As Long
       nPos = InStr(Buffer, vbNullChar)
       If nPos > 0 Then
           StringFromBuffer = Left$(Buffer, nPos - 1)
       Else
           StringFromBuffer = Buffer
       End If
   End Function
   
   
   Public Function ReplaceNullsWithSpaces(str As String) As String
   '-----------------------------------------------------------
   ' Replace all null characters with spaces.
   '-----------------------------------------------------------
       Dim i As Integer
       If Len(str) > 0 Then
           For i = 1 To Len(str)
               If Mid$(str, i, 1) = vbNullChar Then
                   Mid$(str, i, 1) = " "
               End If
           Next i
           ReplaceNullsWithSpaces = Left$(str, Len(str) - 2)
       Else
           ReplaceNullsWithSpaces = str
       End If
   End Function
   
   
   Public Function ComputerName() As String
   '-----------------------------------------------------------
   '  Returns the local computer name.
   '-----------------------------------------------------------
       Dim nLen As Long
       Dim strComputerName As String
       nLen = MAX_COMPUTERNAME_LENGTH
       strComputerName = String$(nLen, 0)
       GetComputerName strComputerName, nLen
       strComputerName = Left$(strComputerName, nLen)
       ComputerName = strComputerName
   End Function
    
    
   Public Function fCheckForCompatibleOS() As Boolean
   '-----------------------------------------------------------
   '  Checks to see if the OS can use integrated security.
   '-----------------------------------------------------------
       Dim osinfo As OSVERSIONINFO
       Dim retvalue As Integer
       osinfo.dwOSVersionInfoSize = 148
       osinfo.szCSDVersion = space$(128)
       retvalue = GetVersionExA(osinfo)
       If osinfo.dwPlatformId >= VER_PLATFORM_WIN32_NT Then
           fCheckForCompatibleOS = True
       Else
           fCheckForCompatibleOS = False
       End If
   End Function

8. Guarde el segundo módulo como GetSQLInstances .
9. Abra el formulario de inicio existente en la vista Diseño, o cree un nuevo formulario de inicio si no dispone de un formulario de inicio.
10. Agregar un comando a la propiedad de evento OnOpen del formulario de inicio para llamar a la función fStartUp .
    
    Debe especificar el nombre de base de datos que desea crear en SQL Server y el nombre de archivo de datos de SQL Server existente. También puede especificar el nombre de inicio de sesión de SQL Server necesario y la contraseña como argumentos opcionales de tercer y cuarto si no utiliza seguridad integrada. Por ejemplo, si desea crear una base de datos se llama Northwind usando un archivo de datos denominado NorthwindSQL.mdf, la función aparece como sigue:

    =fStartUp("Northwind","NorthwindSQL.mdf","","")
    

    Nota esta nota se refiere a seguridad de SQL Server. Si no proporciona un nombre de inicio de sesión en la llamada de función que se menciona anteriormente, el código de este artículo intenta usar seguridad integrada si el sistema operativo subyacente es compatible con (Microsoft Windows NT 4.0, Microsoft Windows 2000 y Microsoft Windows XP). Si el sistema operativo subyacente es Microsoft Windows 98 o Microsoft Windows Millennium Edition, deberá proporcionar una cuenta de usuario de SQL Server válido y la contraseña. Independientemente del sistema operativo, si se especifica al menos un nombre de inicio de sesión, el código intenta conectarse mediante la seguridad de SQL con el nombre de inicio de sesión proporcionado y la contraseña. Si no tiene una copia de su archivo de datos de SQL Server, debe realizar una copia de ese archivo de datos para incluir con el paquete de implementación.
11. En el menú Herramientas , elija Utilidades de base de datos y, a continuación, haga clic en Copiar el archivo de base de datos .
12. En el cuadro de diálogo Abrir resultante, especifique el nombre y la ubicación donde desea guardar el archivo de base de datos, haga clic en Guardar para terminar el proceso y, a continuación, cierre el cuadro de diálogo. Cuando se ejecuta primero el proyecto en el equipo de destino, Access intenta conectarse a SQL Server que se especifica en las propiedades del archivo de conexión. Aunque el código de este artículo sigue ejecutándose y todavía actualiza la información de conexión, es una buena idea para quitar la información de conexión existente antes de implementar.
    
    Para quitar la información de conexión existente, puede ejecutar la función MakeADPConnectionless() , que se incluye en el módulo modCopyConnect.
    
    
13. Para ejecutar la función, escriba lo siguiente en la Ventana Inmediato y, a continuación, presione ENTRAR:

    ?MakeADPConnectionless

14. Guardar los cambios.
15. En el menú complementos , si aparece el Asistente para empaquetar, vaya al paso 19.
16. En el menú complementos , haga clic en Administrador de complementos .
17. En la lista complementos disponibles , haga clic en Asistente para empaquetar .
18. Comportamiento de carga, haga clic en Cargado/descargado y, a continuación, haga clic en Aceptar .
19. En el menú complementos , haga clic en Asistente para empaquetar .
20. Siga los pasos del asistente hasta llegar a la pantalla dependencias .
21. En la pantalla dependencias , haga clic en Agregar archivo para agregar el archivo MDF que copia anteriormente.
22. Haga clic en siguiente hasta llegar a la pantalla Propiedades de tiempo de ejecución de Access . En esta pantalla, haga clic para seleccionar la casilla de verificación de Microsoft SQL Server 2000 Desktop Engine (MSDE) para incluir el motor MSDE.
23. Siga los pasos del Asistente para completar el paquete, o hacer clic en Finalizar siempre que desee.

Una vez creado el paquete, está preparado para instalar el paquete en los equipos de los usuarios finales.

Para obtener información adicional sobre cómo incluir SQL 2000 Desktop Engine en paquetes para otros equipos, haga clic en los números de artículo siguientes para verlos en Microsoft Knowledge Base: Para obtener información adicional acerca de cómo convertir la base de datos SQL 2000 Desktop Engine, haga clic en el número de artículo siguiente para verlo en Microsoft Knowledge Base: