Export (0) Print
Expand All
Expand Minimize

Creating and Deploying Access Solutions with the Microsoft Data Engine

This content is no longer actively maintained. It is provided as is, for anyone who may still be using these technologies, with no warranties or claims of accuracy with regard to the most recent product version or service release.
 

Scott Smith
Microsoft Corporation

April 2001

Applies to:
   Microsoft® Office XP Developer

Summary: You can use the Microsoft Office XP Developer Packaging Wizard to package an Access Data Project (ADP) solution that includes an Access Runtime/MSDE database for distribution. However, you must supply the code needed to find and start the MSDE server and attach the database to the server. This article provides an example of such code. (24 printed pages)

Contents

Introduction Starting MSDE Attach the Database Creating the Connection Putting It All Together Issues Startup Form Code

Introduction

The Microsoft® Desktop Engine (MSDE) is a SQL Server 2000 compatible data storage server that ships with Microsoft Office XP Developer, with rights to redistribute. The Office XP Developer Packaging Wizard has an option for including MSDE when packaging an Access Data Project (ADP) solution. When the solution is installed on a user's machine, MSDE will be installed with it. However, MSDE will not be started, and the database will not be attached to MSDE.

This article provides the code required to find the server, start the server if it is not started already, and attach the database to the server. The code is specific to use within an ADP; however, much of the code can be utilized by any Visual Basic® for Applications (VBA) application.

As a prerequisite, you must have an ADP solution with data existing in a SQL Server or MSDE database. The code for this solution (less the database) is provided at the end of this article. It is also important to note that you must set references to the Microsoft SQL DMO object library and the Microsoft Scripting Runtime.

Starting MSDE

This solution begins with the ADP set in a connectionless state. When the solution is started for the first time, it will perform a check to see whether the connection has already been made and, if not, perform that task. The code for finding and starting MSDE is fairly lengthy, given that multiple instances of MSDE can reside on the same machine and the full name of the instance is based on the machine name combined with an instance name. This code sample will return all of the available instances of SQL/MSDE on the machine, but it is limited in that it will use only the first instance that it finds. While it is not this article's intent to describe the detailed workings of this code, comments are provided at the end of this article in the Module modGetSQLInstances section.

When you have the name of the Server to which you want to attach, the following function checks the state of the server and starts it if necessary (see Module modFirstRunADP):

Public Function sStartMSDE(sSvrName As String, sUID As String, sPWD As String) 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 place the SQL Service Manager on the start bar.
'
'Input:
'   sSvrName    The server to be started
'   sUID        The user used to start server
'   sPWD        The password of user
'
'Output:
'   Resolution of start
'
'References:
'   SQLDMO
'********************************************************************

    Dim osvr As SQLDMO.SQLServer

    Set osvr = CreateObject("SQLDMO.SQLServer") 
    'Create the SQLDMO Server Object
        
    On Error GoTo StartError 'Error Trap
    
    osvr.LoginTimeout = 60
    'Start Server
    osvr.start True, sSvrName, sUID, sPWD
    
    'Return results
    sStartMSDE = "Started " & sSvrName

ExitSub:
    Exit Function

StartError:
    If Err.Number = -2147023840 Then 
    'This error is thrown when the server is already running,
    'and Server.Start is executed on NT
        osvr.Connect sSvrName, sUID, sPWD 'Connect to Server
        
        'Return results
        sStartMSDE = sSvrName & " Already Started"
        
    Else 'Unknown Error
        'Return results
        sStartMSDE = Err.Description
    End If
    
    Resume ExitSub
    
End Function

Attach the Database

This function performs the task of attaching the MDF datafile to the chosen server. In this case, we are using some constants that you must change—specifically the database name, "DemoDatabase," and the MDF datafile, "adp1sql.mdf." In addition, this sample assumes you are attaching to an MSDE server using SQL authentication (see Module modFirstRunADP):

Public Function sCopyMDF(sSvrName As String, sUID As String, sPWD As String, sMDFName As String) As String

'********************************************************************
'This Function will check for DemoDatabase existance on the
'MSDE Server. If the database exists, this function will copy
'adp1sql.mdf from the same location as the ADP to the MSDE Data
'directory. It will then attach adp1sql.mdf.
'
'Input:
'   sSvrName    The server to be started
'   sUID        The user used to start server
'   sPWD        The password of user
'   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 x

On Error GoTo sCopyMDFTrap

    'the drive names used in FSO.Copyfile, and oSvr.AttachDBWithSingleFile
    'need to match the locations for Program Files and MSDE on the
    'endusers machine.

    'initialze return value
    sCopyMDF = ""
    fDataBaseFlag = False
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set osvr = CreateObject("SQLDMO.SQLServer")
    
    'Log onto database
    osvr.Connect sSvrName, sUID, sPWD
    
    x = osvr.Databases.Count  'if this fails DMO needs to inititalize
    
    'Check to for DemoDatabase existance on Local MSDE Server
    'by looping through all database names on the local MSDE Server
    For Each db In osvr.Databases
    
        If db.Name = "DemoDatabase" Then 'The database exists
            fDataBaseFlag = True
            Exit For 'Get out of loop
        End If
  
    Next
    
    If Not fDataBaseFlag Then 'There is no database named DemoDatabase
        'Copy File to data folder
         FSO.CopyFile Application.CurrentProject.Path & "\" & sMDFName, _
             osvr.Databases("master").PrimaryFilePath & sMDFName, True
        'Attach to database
        strMessage = osvr.AttachDBWithSingleFile("DemoDatabase", _
            osvr.Databases("master").PrimaryFilePath & sMDFName)
        'Return Results
        sCopyMDF = "Copied " & sMDFName & " to MSDE Data Directory"
    Else
        sCopyMDF = sMDFName & " Exists on MSDE Server"
    End If
     
ExitCopyMDF:
    osvr.Disconnect
    Set osvr = Nothing
Exit Function
    
sCopyMDFTrap:

    If Err.Number = -2147216399 Then  'DMO need to be initialized
        Resume Next
    Else
        sCopyMDF = Err.Description
    End If
    Resume ExitCopyMDF
Exit Function
    
End Function

Creating the Connection

When the database is attached to the server, the final step is to create the connection between the ADP file and the database. The following function performs this step (see Module modFirstRunADP):

Public Function sCreateConnection(sSvrName As String, sUID As String, sPWD As String, sDatabase As String) As String
'********************************************************************
'This Function will check for a connection in the ADP. If there is
'none it will create one using the input parameters
'
'Input:
'   sSvrName    The server to be started
'   sUID        The user used to start server
'   sPWD        The password of user
'   sDatabase   The Name of the MSDE Database
'
'Output:
'   Resolution of copy
'
'********************************************************************

    On Error GoTo sCreateConnectionTrap:
    
    If Application.CurrentProject.BaseConnectionString = "" Then
        'This adp is connectionless
        sConnectionString = "PROVIDER=SQLOLEDB.1;PASSWORD=" & sPWD _
            & ";PERSIST SECURITY INFO=TRUE;USER ID=" & sUID & "; _
            INITIAL CATALOG=" & sDatabase & ";DATA SOURCE=" & sSvrName
        Application.CurrentProject.OpenConnection sConnectionString
        sCreateConnection = "Created Connection to " & sDatabase
    Else 'Connection exists
        sCreateConnection = "Connection exists to " & sDatabase
    End If
    
    
sCreateConnectionExit:
Exit Function

sCreateConnectionTrap:
    sCreateConnection = Err.Description
    Resume sCreateConnectionExit

End Function

This article also includes code for dropping the database from the server and stripping the connection information from the ADP. This can be used for testing purposes (see module modCleanup).

Putting It All Together

This code and your database, combined with the Office XP Developer Packaging Wizard, are all you must have to create a redistributable Access Runtime/MSDE database solution. The following steps describe how to put it all together:

  1. Create an Access ADP Solution against an existing SQL Server or MSDE.
  2. Place the startup form code in your Startup form. You might have to modify this to fit the requirements of your Startup form. If you do not want the reset code, you should remove the btnReset function. Set the form to load on startup (menu Tools|Startup).
  3. Add the rest of the code as modules in your project, and provide any modifications.
  4. Set References to the Microsoft SQL DMO object library and the Microsoft Scripting Runtime.
  5. Save the project, and run the Office XP Developer Packaging Wizard. If you run the Packaging Wizard from the Start menu, choose the ADP file as your main file.
  6. In the Packaging Wizard, make sure the following options are set:
    • Access Runtime is selected.
    • MSDE is selected.
    • Optionally, you can set the Access Runtime Profile settings for help file, title, icon, and startup bitmap from within the shortcut properties.

Complete the Packaging Wizard, and build the setup program.

Then, the solution should be ready to be installed on any machine.

Issues

The most difficult issue to overcome is the task of targeting a specific instance of MSDE on the user's machine. This solution works best if the MSDE instance installed with the solution is the only one on the machine. If there is more than one instance and you require the database to be connected to a specific instance, you must provide additional code to request the name of the instance from the user. Unfortunately, the Packaging Wizard does not save the name of the instance it installs.

Startup Form Code

This code is provided for completeness and demonstrates how to stitch all the other pieces together. To use this code, create a form and put a single button, named btnReset, on it. Put this code behind the form, and set this form to load on startup.

Option Compare Database
Option Explicit
Dim SQLInstance As String
'This form has one button to reset the solution – btnReset.  This will
'make the ADP connectionless and drop the database from the server,
'making it easy to re-test the code.  
'This shouldn't be included as part of a deployed solution, however. 

Private Sub btnReset_Click()
'Resets the solution by making the ADP connectionless, and drops the
'database from the server.
    DeleteMDF SQLInstance, "sa", "", "DemoDatabase"
    'Drop current database
    MakeADPConnectionless 'Make ADP connectionless
End Sub

Private Sub Form_Open(Cancel As Integer)
Dim sSQLInt As String
Dim b As Boolean
Dim x As Integer
'Find the available instances of MSDE/SQL on the machine
x = GetValidSQLInstances(sSQLInt, b)
SQLInstance = ComputerName & "\" & sSQLInt
'Call startMSDE from modFistRunADP and return results to a message box
MsgBox sStartMSDE(SQLInstance, "sa", "")
'Call sCopyMDF from modFistRunADP and return results to a message box
MsgBox sCopyMDF(SQLInstance, "sa", "", "starssql.mdf")
'Call sCreateConnection from modFistRunADP and return results to a message
'box
MsgBox sCreateConnection(SQLInstance, "sa", "", "DemoDatabase")

End Sub

Module modGetSQLInstances

Option Compare Database
'This module provides functions that work together to perform the task of
'finding existing SQL Servers, as well as the computer name.

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 OSRegCloseKey Lib "advapi32" Alias "RegCloseKey"
   (ByVal hKey As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
   "GetComputerNameA" ( _
       ByVal lpBuffer As String, nSize As Long) As Long

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 REG_SZ = 1
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_MULTI_SZ = 7

'-----------------------------------------------------------
' SUB: GetValidSQLInstances
'
' Returns number of valid SQL and a string delimited by
' spaces of the list of instances.
'-----------------------------------------------------------
'
Public Function GetValidSQLInstances(ByRef sSQLInstances As String, ByRef
   fIsDefaultSQL7 As Boolean) As Integer
    Dim hKey As Long
    Dim sValue As String
    'Dim sVerInfo As VERINFO
    Dim i As Integer

    fIsDefaultSQL7 = False
    sSQLInstances = ""
    GetValidSQLInstances = 0
    If RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Microsoft _
        SQL Server", hKey) Then
        RegQueryStringValue hKey, "InstalledInstances", sSQLInstances
        RegCloseKey hKey
        StrConv sSQLInstances, vbUpperCase
        If InStr(1, sSQLInstances, "MSSQLSERVER") Then
           If RegOpenKey(HKEY_LOCAL_MACHINE, _
           "Software\Microsoft\MSSQLServer\MSSQLServer\CurrentVersion", _
           hKey) Then
                RegQueryStringValue hKey, "CurrentVersion", sValue
                RegCloseKey hKey
                'PackVerInfo sValue, sVerInfo
                'If sVerInfo.FileVerPart1 = 7 Then
                'fIsDefaultSQL7 = True
                'End If
            End If
        End If
        For i = 1 To Len(sSQLInstances)
            If Mid$(sSQLInstances, i, 1) = " " Then
                GetValidSQLInstances = GetValidSQLInstances + 1
            End If
        Next i
    End If
End Function


'-----------------------------------------------------------
' FUNCTION: RegOpenKey
'
' Opens an existing key in the system registry.
'
' Returns: True if the key was opened OK, False otherwise
'   Upon success, phkResult is set to the handle of the key.
'-----------------------------------------------------------
'
Public Function RegOpenKey(ByVal hKey As Long, ByVal lpszSubKey As String,
   phkResult As Long) As Boolean
    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

'-----------------------------------------------------------
' FUNCTION: RegCloseKey
'
' Closes an open registry key.
'
' Returns: True on success, else False.
'-----------------------------------------------------------
'
Public Function RegCloseKey(ByVal hKey As Long) As Boolean
    Dim lResult As Long

    lResult = OSRegCloseKey(hKey)
    RegCloseKey = (lResult = ERROR_SUCCESS)
End Function

'-----------------------------------------------------------
'Given an HKEY, return the text string representing that
'key.
'-----------------------------------------------------------
'
Private Function strGetHKEYString(ByVal hKey As Long) As String
    Dim strKey As String
    Dim intIdx As Integer

    'Is the hkey predefined?
    strKey = strGetPredefinedHKEYString(hKey)
    If Len(strKey) > 0 Then
        strGetHKEYString = strKey
        Exit Function
    End If
 End Function

'-----------------------------------------------------------
'Given a predefined HKEY, return the text string representing that
'key, or else return vbNullString.
'-----------------------------------------------------------
'
Private Function strGetPredefinedHKEYString(ByVal hKey As Long) As String
    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


'-----------------------------------------------------------
' FUNCTION: RegQueryStringValue
'
' Retrieves the string data for a named
' (strValueName = name) or unnamed (Len(strValueName) = 0)
' value within 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
'-----------------------------------------------------------
'
Public Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String, strData As String) As Boolean
    Dim lResult As Long
    Dim lValueType As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    
    ' Get length/data type
    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

'-----------------------------------------------------------
' Replace all null characters with spaces
'-----------------------------------------------------------
'
Public Function ReplaceNullsWithSpaces(str As String) As String
    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
    Dim nLen As Long
    Dim sComputerName As String
    Dim iSuffix As Integer

    nLen = 16 ' Max length for computer name + 1
    sComputerName = String$(nLen, 0)
    GetComputerName sComputerName, nLen
    'Win98 returns nlen-number of nulls
    sComputerName = Left$(sComputerName, nLen)

    iSuffix = 0
    Do While InStr(1, gstrSQLInstances, sComputerName)
        If iSuffix > 9 Then
            Exit Do
        ElseIf iSuffix = 0 Then
            sComputerName = sComputerName + CStr(iSuffix)
        Else
            Mid(sComputerName, nLen + 1, 1) = CStr(iSuffix)
        End If
        iSuffix = iSuffix + 1
    Loop
    
    ComputerName = sComputerName
 End Function

Module modFirstRunADP

Option Compare Database

'The code in this project demonstrates connecting an MDF file
'to a local MSDE, then establishing the connection to the 
'connectionless ADP.


Public Function sStartMSDE(sSvrName As String, sUID As String, sPWD As String) 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 place the SQL Service Manager on the start bar.
'
'Input:
'   sSvrName    The server to be started
'   sUID        The user used to start server
'   sPWD        The password of user
'
'Output:
'   Resolution of start
'
'References:
'   SQLDMO
'********************************************************************

    Dim osvr As SQLDMO.SQLServer

    Set osvr = CreateObject("SQLDMO.SQLServer") 
    'Create the SQLDMO Server Object
        
    On Error GoTo StartError 'Error Trap
    
    osvr.LoginTimeout = 60
    'Start Server
    osvr.start True, sSvrName, sUID, sPWD
    
    'Return results
    sStartMSDE = "Started " & sSvrName

ExitSub:
    Exit Function

StartError:
    If Err.Number = -2147023840 Then 
    'This error is thrown when the server is already running, 
    'and Server.Start is executed on NT
        osvr.Connect sSvrName, sUID, sPWD 'Connect to Server
        
        'Return results
        sStartMSDE = sSvrName & " Already Started"
        
    Else 'Unknown Error
        'Return results
        sStartMSDE = Err.Description
    End If
    
    Resume ExitSub
    
End Function


Public Function sCopyMDF(sSvrName As String, sUID As String, sPWD As String, sMDFName As String) As String

'********************************************************************
'This Function will check for DemoDatabase existance on the
'MSDE Server. If the database exists, this function will copy
'adp1sql.mdf from the same location as the ADP to the MSDE Data
'directory. It will then attach adp1sql.mdf.
'
'Input:
'   sSvrName    The server to be started
'   sUID        The user used to start server
'   sPWD        The password of user
'   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 x

On Error GoTo sCopyMDFTrap

    'the drive names used in FSO.Copyfile and oSvr.AttachDBWithSingleFile
    'need to match the locations for Program Files and MSDE on the
    'end users machine.

    'initialze return value
    sCopyMDF = ""
    fDataBaseFlag = False
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set osvr = CreateObject("SQLDMO.SQLServer")
    
    'Log onto database
    osvr.Connect sSvrName, sUID, sPWD
    
    x = osvr.Databases.Count  'If this fails DMO needs to inititalize
    
    'Check to for DemoDatabase existance on Local MSDE Server
    'by looping through all database names on the local MSDE Server
    For Each db In osvr.Databases
    
        If db.Name = "DemoDatabase" Then 'The database exists
            fDataBaseFlag = True
            Exit For 'Get out of loop
        End If
  
    Next
    
    If Not fDataBaseFlag Then 'There is no database named DemoDatabase
        'Copy File to data folder
        FSO.CopyFile Application.CurrentProject.Path & "\" & sMDFName, _
            osvr.Databases("master").PrimaryFilePath & sMDFName, True
        'Attach to database
        strMessage = osvr.AttachDBWithSingleFile("DemoDatabase", _
            osvr.Databases("master").PrimaryFilePath & sMDFName)
        'Return Results
        sCopyMDF = "Copied " & sMDFName & " to MSDE Data Directory"
    Else
        sCopyMDF = sMDFName & " Exists on MSDE Server"
    End If
     
ExitCopyMDF:
    osvr.Disconnect
    Set osvr = Nothing
Exit Function
    
sCopyMDFTrap:

    If Err.Number = -2147216399 Then  'DMO need to be initialized
        Resume Next
    Else
        sCopyMDF = Err.Description
    End If
    Resume ExitCopyMDF
Exit Function
    
End Function

Public Function sCreateConnection(sSvrName As String, sUID As String, sPWD As String, sDatabase As String) As String
'********************************************************************
'This Function will check for a connection in the ADP. If there is
'none it will create one using the input parameters
'
'Input:
'   sSvrName    The server to be started
'   sUID        The user used to start server
'   sPWD        The password of user
'   sDatabase   The Name of the MSDE Database
'
'Output:
'   Resolution of copy
'
'********************************************************************

    On Error GoTo sCreateConnectionTrap:
    
    If Application.CurrentProject.BaseConnectionString = "" Then 
    'This adp is connectionless
        sConnectionString = "PROVIDER=SQLOLEDB.1;PASSWORD=" & sPWD _
            & ";PERSIST SECURITY INFO=TRUE;USER ID=" & sUID & "; _
            INITIAL CATALOG=" & sDatabase & ";DATA SOURCE=" & sSvrName
        Application.CurrentProject.OpenConnection sConnectionString
        sCreateConnection = "Created Connection to " & sDatabase
    Else 'Connection exists
        sCreateConnection = "Connection exists to " & sDatabase
    End If
    
    
sCreateConnectionExit:
Exit Function

sCreateConnectionTrap:
    sCreateConnection = Err.Description
    Resume sCreateConnectionExit

End Function

Module modCleanup

Option Compare Database

'This code is designed to Reset the example. It will however create a
'connectionless ADP using MakeADPConnectionless.

Sub MakeADPConnectionless()
'********************************************************************
'This subroutine will remove the connection from the ADP rendering
'it connectionless
'********************************************************************
    Application.CurrentProject.CloseConnection 'Close the Connection
    Application.CurrentProject.OpenConnection 'Set the connection to
                                              'nothing
End Sub

Sub DeleteMDF(sSvrName As String, sUID As String, sPWD As String, sDatabase As String)
'********************************************************************
'This subroutine will drop the currently connected database from the
'MSDE Server using SQLDMO to remove the database
'
'Note: There is a loop with the error trap to workaround dropping a
'connection
'
'References:
'   adodb
'********************************************************************
    Dim osvr As SQLDMO.SQLServer
    Dim i As Integer
 
    On Error GoTo DeleteMDFTrap
    
    Application.CurrentProject.CloseConnection 'Close the connection

    Set osvr = CreateObject("SQLDMO.SQLServer") 'Create SQLDMO Object
    osvr.Connect sSvrName, sUID, sPWD 'Connect to MSDE Server
    
    osvr.Databases(sDatabase).Remove 'Remove databaes
    
    
DeleteMDFExit: 'Clean up
    osvr.Close
    Set osvr = Nothing
Exit Sub

    
DeleteMDFTrap:
    Select Case Err.Number
    
    Case 6008 'Workaround issue with closing connection
        If i < 99 Then 'Continue looping to try to close connection
            DoEvents
            Resume
        Else 'Something will not let the connection close
             'so stop trying and get out
            MsgBox Err.Description
            Resume DeleteMDFExit
        End If
            
    Case Else
        MsgBox Err.Description
        Resume DeleteMDFExit
    End Select
Exit Sub

End Sub
Show:
© 2014 Microsoft