ACC2000: How to Use SQL-DMO to Copy an Existing MSDE or SQL Server Database to a New Database

Option Explicit
					

 

Function CopySQLDB(strLogin As String, strPwd As String, _
strSrv As String, strDatabase As String, strNewName As String)

'===============================================================
' Parameters
' --------------------------------------------------------------
' strLogin:  Name of the Login account used.
' strPwd:  The Password for the login account.
' strSrv:  The server to which you are connecting.
' strDataBase:  The name of the database you want to copy.
' strNewName: Desired name of the new copy of the database.
'===============================================================

   Dim sql As Object
   Dim db As Object
   
   Dim strMDFfilePath As String
   Dim strMDFfileName As String
   Dim strLOGfile As String
      
   On Error GoTo CopySQLDB_Err
   
   'Create Objects
   Set sql = CreateObject("SQLDMO.SQLServer")
   Set db = CreateObject("SQLDMO.Database")
   
   'Connect to the server
   sql.Connect strSrv, strLogin, strPwd
   
   'Set the database object
   Set db = sql.Databases(strDatabase, "dbo")
      
   'Determine the location of database files, primary and log
   strMDFfilePath = db.PrimaryFilePath
   strMDFfileName = _
   Trim(db.FileGroups.Item(1).DBFiles.Item(1).PhysicalName)
   strLOGfile = Trim(db.TransactionLog.LogFiles(1).PhysicalName)

   'Clear out the database object
   Set db = Nothing
   
   'Detach database to allow copying
   sql.DetachDB (strDatabase)

   'Copy database files to new names
   FileCopy strMDFfileName, strMDFfilePath & strNewName & ".mdf"
   FileCopy strLOGfile, strMDFfilePath & strNewName & "_log.ldf"
   
   'Re-attach original database
   sql.AttachDB strDatabase, strMDFfileName & "," & strLOGfile
   sql.AttachDB strNewName, strMDFfilePath & strNewName & _
   ".mdf" & "," & strMDFfilePath & strNewName & "_log.ldf"
   
   'Set database object to the new database
   Set db = sql.Databases(strNewName, "dbo")
   Debug.Print "Database Created"
   
   
CopySQLDB_End:
   'Clear out the objects before ending
   Set db = Nothing
   Set sql = Nothing
   Exit Function
            
CopySQLDB_Err:
   'Basic error handling.
   MsgBox Err.Description, vbInformation, "SQL OLE Automation"
   Resume CopySQLDB_End

End Function
						

?CopySQLDB("sa","","(local)","NorthwindCS","NwindCS")