Mentioned
In
|
 |
 |
 |
 |
Microsoft Knowledge Base Article
This article contents is Microsoft Copyrighted material.
©2005-©2007 Microsoft Corporation. All rights reserved. Terms
of Use |
Trademarks
Article ID: 884457 - Last Review: July 5, 2005 - Revision: 3.3 How to deploy an Access 2003 project that connects to an existing SQL Server 2000 database This
article applies only to a Microsoft Access project (.adp).
Advanced: Requires expert coding, interoperability, and multiuser
skills.
Microsoft Office Access 2003 projects that connect to a
Microsoft SQL Server 2000 database can be deployed by using the Package Wizard
that is included with the Microsoft Office Access 2003 Developer Extensions. In
an Access 2003 module, you can attach code that can automate the following required steps: - Find the server.
- Start the server.
- Attach the
SQL Server 2000 database to the server.
- Connect the project to the newly attached
SQL Server 2000 database.
This article contains code that you can use to complete the four steps that are mentioned in the "Introduction" section. The code is specific to a Microsoft Access project. However, much of the code
can be used by any Microsoft Visual Basic for Applications (VBA) application.
Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements. Steps to modify an existing project application for deploymentThe following steps assume that you already have a
working project application that is ready to deploy. The steps show you
how to add code to your project, how to make required
adjustments to your startup form, and how to create a deployment package for an
existing Microsoft Access project (*.adp) that connects to an existing SQL
Server 2000 database.
- Open the Access project that you want to deploy, and then
create a new module.
Because the code that you include uses
SQL Server Distributed Management Objects (SQLDMO) code and scripting, you must make sure that the required references are
present. - On the Tools menu, click References in the Visual Basic
Editor.
- In the References dialog box, click to
select the Microsoft SQLDMO Object Library check box, and then click to select the Microsoft Scripting Runtime check box.
- Click OK to close the
References dialog box.
- Put the following code in the new module that you created in step 1:
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 and 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 Server 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 instance of SQL Server 2000 on the computer.
'The following code picks the default, or first instance, if more than
'one instance 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 SQL Server 2000 database.
fChangeADPConnection strServername, strDBName, strUN, strPW
End Function
Public Function fStartMSDE(strServername As String, _
Optional strUN As String, Optional strPW As String)
'------------------------------------------------------------
'This subroutine turns on MSDE. If the server has been
'started, the error trap exits the function and leaves the
'server running.
'
'Notice that it will not put the SQL Service Manager on
'the start bar.
'
'Input:
' strServername The server to be started
' strUN The user who is used to start the server
' strPW The password of the 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, on Windows 2000, or on Windows XP.
osvr.Connect strServername, strUN, strPW 'Connect to the 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 SQL Server 2000 database is already on
'the MSDE Server. If the SQL Server 2000 database does not exist, this
'function copies the MDF file from the same location as the
'ADP file to the Data directory of MSDE and then attaches the SQL Server 2000 database.
'
'Input:
' strServername The server to be started
' strUN The user who is used to start the server
' strPW The password of the user
' strDBName The name of the SQL Server 2000 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 that are used in FSO.Copyfile and
'in oSvr.AttachDBWithSingleFile must match the
'locations for Program Files and for 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 the SQL Server 2000 database existence on the 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 SQL Server 2000 database exists.
fDataBaseFlag = True
Exit For 'Get out of the loop.
End If
Next
If Not fDataBaseFlag Then 'The SQL Server 2000 database does not exist
'that matches sDBName.
'Copy the file to the data folder.
FSO.CopyFile Application.CurrentProject.Path _
& "\" & sMDFName, _
osvr.Databases("master").PrimaryFilePath & _
sMDFName, True
'Attach to the 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 opens 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 who is used to start the server
' strPW The password of the 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 - Save this module as
ModCopyConnect.
- Create a second module, and then put the following code in the second module:
Option Compare Database
Option Explicit
'This module provides functions that work together to
'find existing computers that are running instances of SQL Server and also to find 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 the 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
' This opens an existing key in the system registry.
' True is returned if the key opens successfully. Otherwise, False
' is returned.
' 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 that represents 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 that represents
'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
'-----------------------------------------------------------
' This retrieves the string data for a named
' (strValueName = name) or for an 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
'-----------------------------------------------------------
' The following 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
'-----------------------------------------------------------
' The following checks to see if the operating system 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
- Save the second module as
GetSQLInstances.
- Open your existing startup form in Design view. Or, create a
new startup form if you do not have a startup form.
- Add a command to the OnOpen event property of your startup form to call the fStartUp function.
You must specify the SQL Server 2000 database name that you
want to create on the computer that is running SQL Server. You must also specify the existing SQL Server data file name.
You can also specify the required SQL Server logon name as an
optional third argument. You can specify the password as an optional fourth argument. Both the third and fourth arguments can be specified if you are not using integrated security.
For example, if you want to create a database that is named Northwind by using
a data file that is named NorthwindSQL.mdf, the function call appears as follows: =fStartUp("Northwind","NorthwindSQL.mdf","","") Note This note concerns SQL Server security. If you do not supply a
logon name in the fStartUp function call, the fStartUp function call tries to use integrated security if the underlying operating system
supports integrated security. For example, the underlying operating systems for Microsoft
Windows 2000 and for Microsoft Windows XP support integrated security.
If the underlying operating system does not
support integrated security, you
have to provide a valid SQL Server user account and password.
Regardless of the operating system, if you specify at least a logon name, the
code tries to connect by using SQL Server security with the supplied logon name and
password. If you do not have a copy of your SQL Server data file, you must make
a copy of that data file to include with your deployment package. - On the Tools menu, point to
Database Utilities, and then click Copy Database
File.
- In the Open dialog box, specify
the name and the location where you want to save the database file, click
Save to finish the process, and then close the dialog box.
When the project is first run on the destination computer, Access 2003 tries to connect
to the computer that is running SQL Server that is specified in the connection properties of the file.
Although the previous sample code still runs and still updates the connection
information, it is a good idea to remove the existing connection information
before you deploy.
To remove the existing connection information, you
can run the MakeADPConnectionless function that is included in the ModCopyConnect
module. - To run the function, put the following in the
Immediate window, and then press ENTER:
- Save your changes.
- To complete the deployment of your Access
2003 solution, open the Package Wizard that is included with Microsoft Office Access
2003 Developer Extension.
For additional information about how to create a distributable Access
run-time application, click the following article number to view the article in the Microsoft Knowledge Base:
842004Â
(http://kbalertz.com/Feedback.aspx?kbNumber=842004/
)
How to create a distributable Access run-time application by using Microsoft Office Access 2003 Developer Extensions
For additional information about deploying an Access 2003 project with SQL
Server 2000, click the following article numbers to view the articles in the Microsoft Knowledge Base:
299297Â
(http://kbalertz.com/Feedback.aspx?kbNumber=299297/
)
How to deploy an Access 2002 project that includes the Microsoft SQL Server 2000 Desktop Engine
326613Â
(http://kbalertz.com/Feedback.aspx?kbNumber=326613/
)
How to distribute and how to install SQL-DMO for SQL Server 2000
APPLIES TO- Microsoft Office Access 2003
| kbconfig kbprogramming kbsetup kbdeployment kbhowto KB884457 |
Community Feedback System
Very often, it takes hours to solve a problem. Very often, you've looked high
and low, and have tried a lot of solutions. When you finally found it, chances
are, it was because someone else helped you. Here's your chance to give back.
Use our community feedback tool to let others know what worked for you and what
didn't.
Please also understand that the community feedback system is not warranted to be
correct, it's simply a system that we've built to let people try and help each
other. If something in a feedback response doesn't make sense to you, or you're
not comfortable making changes that the feedback talks about (like registry
edits), please consult a professional.
Thank you for using kbAlertz.com Feedback System.
-- Scott Cate
Be the first to leave feedback, to help others about this knowledge base
article.
(Optional) Name
(Optional)
Public URL Or Email
Comments
No
HTML -- Text Only Please
|
 |
 |
 |
 |
 |
 |
 |
| |