Extract an Entire Database from SQL Server into Access

Often times Data Conversion projects migrate from Access to SQL Server in order to bypass the 2GB limit on the size of Access databases. Sometimes it goes the other way. When a young legacy system has yet to accumulate 2GB of data, it might be easier to work with in Access.

Working with an Access database on a local hard drive will almost always be faster than working on a SQL server in another country. Manipulating data over a network presents a great deal of overhead and latency even when the server is in the same room.

Safety's sake

Working on a legacy system while it's still in production is dangerous. Taking a snapshot of the source data and working only with this offline version ensures that no catastrophic failure occurs as a result of a careless keystroke. Having the data on a laptop makes working nights and weekends much easier.

Taking a snapshot also ensures that policies regarding a cutoff date for the legacy system are observed. Any changes to data in the legacy system that occur after the snapshot can be ignored. In some situations the legacy system is left online for historical reference.

You've been warned!

The 2GB limit on Access databases applies even when nobody is watching. Ensure first that the source doesn't exceed 2GB before downloading. If there are memo fields (blobs) in the source that nobody needs, consider skipping them or limiting the length by tweaking this source code.

Not married to SQL Server

The code below can be used for almost any ODBC source. Changing the DRIVER= in the connection string opens whole new worlds for extracting Oracle, mySQL or any other ODBC compatible data source including other Access databases and Excel!

Function RipSQLServer(strServer As String, strUserID As String, strPassword As String, strDatabase As String) As Boolean
    
    '   Note: Ripping a SQL server into an Access database might cause
    '   it to exceed the 2GB limitation imposed by the programmers.
    '   Special thanks: http://www.eileenslounge.com/viewtopic.php?f=29&t=5886

    Dim x, strODBC As String, nCurSec As Long
    strODBC = "DRIVER=SQL Server;SERVER=" & strServer & ";UID=" & strUserID & _
      ";PWD=" & strPassword & ";APP=Microsoft Office 2003;WSID=Computer;DATABASE=" & _
      strDatabase & ";Trusted_Connection=No"
    
    
    'Setup for the ADODB connection to SQL Server
    Dim db As ADODB.Connection
    Dim objCat As ADOX.Catalog
    Dim objTbl As ADOX.Table
    Dim objInd As ADOX.Index
    Dim objCol As ADOX.Column
    Dim objRS As ADODB.Recordset
    Dim objFld As ADODB.Field
    
    'Setup the local connection in this database.
    Dim dbs As DAO.Database
    Set dbs = CurrentDb
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim fName As String
    Dim fType As Integer
    Dim fSize As Integer
    Dim rs As DAO.Recordset
    
    Set db = New ADODB.Connection
    db.ConnectionString = strODBC
    db.Open
    Set objCat = New ADOX.Catalog
    objCat.ActiveConnection = db
    For Each objTbl In objCat.Tables
        If objTbl.Type = "TABLE" Then
            Set objRS = New ADODB.Recordset
            objRS.Open objTbl.Name, db, adOpenDynamic, adLockOptimistic
        
            For Each tdf In dbs.TableDefs
                If tdf.Name = objTbl.Name Then
                    'this table already exists!  Delete it.
                    dbs.TableDefs.Delete (objTbl.Name)
                End If
            Next
            
            Set tdf = dbs.CreateTableDef(objTbl.Name)
            For Each objCol In objTbl.Columns
                If objCol.DefinedSize < 256 Then
                    Set fld = tdf.CreateField(objCol.Name, dbText, objCol.DefinedSize)
                Else
                    Set fld = tdf.CreateField(objCol.Name, dbMemo, 255)
                End If
                fld.AllowZeroLength = True
                fld.Required = False
                tdf.Fields.Append fld
            Next
            dbs.TableDefs.Append tdf
            dbs.TableDefs.Refresh
            
            Set rs = dbs.OpenRecordset(objTbl.Name)
            Do While Not objRS.EOF
                rs.AddNew
                For Each objFld In objRS.Fields
                    'Avoid type mismatch with trim and &""
                    rs.Fields(objFld.Name).Value = Trim("" & objFld.Value) 
                Next
                rs.Update
                objRS.MoveNext
                If Second(Now) <> nCurSec Then
                    'update once each second
                    nCurSec = Second(Now)
                    x = DoEvents()
                End If
            Loop
            rs.Close
            
            objRS.Close
        End If
    Next
    dbs.Close
    db.Close
    RipSQLServer = True
    
    'Clean up to prevent memory leaks.
    Set db = nothing
    Set objCat = nothing
    Set objTbl = nothing
    Set objInd = nothing
    Set objCol = nothing
    Set objRS = nothing
    Set objFld = nothing
    Set dbs = nothing
    Set dbs = nothing
    Set tdf = nothing
    Set fld = nothing
    Set rs = nothing
    
End Function

References available upon request

VBA depends on many Dynamic-link Libraries (DLLs) to make this code work. Be sure to include the libraries below in VBA by clicking Tools → References and adding the most recent versions available of these libraries.