Knowledge Base Item

Table structures in Access can be migrated to SQL Server using the Import feature in SQL Server Management Studio.
However, there are difficulties with this for a number of reasons, probably the most significant being that SSMS Import will not create identity fields corresponding to Access autonumbers.
The code below will create a script which, when executed in SQL Server, creates all your tables in a SQL database and handles the creation of identities and common types of constraints.
Please note that some assumptions are made about how some data types are translated, and not all situations are handled. Check the output script carefully before you execute it, both for incompatibilities with your intended translation and also for inline error messages.

Function goScriptCreate() As Boolean
Dim fso As Object, oFile As Object, dbs As DAO.Database, tdf As TableDef, fld As DAO.Field, idx As Index, strOutput As String
Dim strPrimaryKey As String, strTypeName As String, strConstraints As String, parTablename As String, boolFldRequired As Boolean
Const cDatabase = "ACF_OurSpace"
Const cDropTables As Boolean = True

    Set fso = CreateObject("Scripting.FileSystemObject")
    
    strOutput = Mid(CurrentDb().Name, 1, InStrRev(CurrentDb().Name, "\")) & "TableScripts.txt"
    
    Set oFile = fso.CreateTextFile(strOutput)
    oFile.writeline "USE [" & cDatabase & "]"
    oFile.writeline "GO"
            
    Set dbs = CurrentDb()
    For Each tdf In dbs.TableDefs
    
        parTablename = tdf.Name
        strConstraints = ""
        
        If Left(tdf.Name, 1) <> "~" And Left(tdf.Name, 4) <> "MSys" And tdf.Connect = "" Then
            strPrimaryKey = getPrimaryKey(tdf.Name)
            oFile.writeline " "
            oFile.writeline " "
            oFile.writeline "/********************************************"
            oFile.writeline "     " & IIf(cDropTables, "Drop and Create table", "Create new table") & " '" & parTablename & "'"
            oFile.writeline "     Autoscripted at " & Now()
            oFile.writeline "********************************************/"
            oFile.writeline " "
            oFile.writeline "SET ANSI_NULLS ON"
            oFile.writeline "GO"
            oFile.writeline "SET QUOTED_IDENTIFIER ON"
            oFile.writeline "GO"
            
            If cDropTables Then
                oFile.writeline " "
                oFile.writeline " "
                oFile.writeline "DROP TABLE IF EXISTS [dbo].[" & parTablename & "]"
                oFile.writeline "GO"
                oFile.writeline " "
                oFile.writeline " "
            End If
            
            oFile.writeline "CREATE TABLE [dbo].[" & parTablename & "]( "
            
            For Each fld In tdf.Fields
                
                boolFldRequired = (fld.Required) Or (InStr(strPrimaryKey, "[" & fld.Name & "]") > 0)
                
                If fld.Attributes And dbAutoIncrField Then
                    oFile.writeline "    [" & fld.Name & "] [int] IDENTITY(1,1) NOT NULL,"
                Else
                    Select Case fld.Type
                        Case 1, 2   ' 1=Yes/No, On/Off, True/False, 2=Number (byte)
                            strTypeName = "Byte"
                            oFile.writeline "    [" & fld.Name & "] [int] " & IIf(boolFldRequired, "NOT ", "") & "NULL,"
                        Case 3, 4    'Integer
                            oFile.writeline "    [" & fld.Name & "] [int] " & IIf(boolFldRequired, "NOT ", "") & "NULL,"
                            Select Case fld.Properties("DefaultValue")
                                Case "Date()"
                                    strConstraints = strConstraints & vbCrLf & "ALTER TABLE [dbo].[" & parTablename & "] ADD  CONSTRAINT [DF_" & parTablename & "_" & fld.Name & "]  DEFAULT (getdate()) FOR [" & fld.Name & "]"
                                    strConstraints = strConstraints & vbCrLf & "GO"
                                Case "0"
                                    strConstraints = strConstraints & vbCrLf & "ALTER TABLE [dbo].[" & parTablename & "] ADD  CONSTRAINT [DF_" & parTablename & "_" & fld.Name & "]  DEFAULT ((0)) FOR [" & fld.Name & "]"
                                    strConstraints = strConstraints & vbCrLf & "GO"
                                Case vbNullString
                                Case Else
                                    Debug.Print "Table " & parTablename & "." & fld.Name & "." & fld.Properties("DefaultValue"); ": Unknown constraint"
                                    strConstraints = strConstraints & vbCrLf & "--*********************"
                                    strConstraints = strConstraints & vbCrLf & "-- UNKNOWN CONSTRAINT *"
                                    strConstraints = strConstraints & vbCrLf & "--*********************"
                                End Select
                        Case 5
                            oFile.writeline "    [" & fld.Name & "] [money] " & IIf(boolFldRequired, "NOT ", "") & "NULL,"
                        Case 6, 7, 20    ' 6=Single, 7=double, 20=decimal
                            oFile.writeline "    [" & fld.Name & "] [numeric] (18,4) " & IIf(boolFldRequired, "NOT ", "") & "NULL,"
                        Case 8    'Date
                            oFile.writeline "    [" & fld.Name & "] [datetime] " & IIf(boolFldRequired, "NOT ", "") & "NULL,"
                        Case 10
                            oFile.writeline "    [" & fld.Name & "] [nvarchar](" & fld.Size & ") " & IIf(boolFldRequired, "NOT ", "") & "NULL,"
                        Case 12
                            oFile.writeline "    [" & fld.Name & "] [nvarchar](max) NULL,"
                        Case 104
                            If fld.Properties("DisplayControl") <> 109 Then
                                oFile.writeline "--***********************"
                                oFile.writeline "-- Field " & fld.Name & Space(15 - Len(fld.Name)) & "*"
                                oFile.writeline "-- Lookup Data Type " & fld.Type & " *"
                                oFile.writeline "-- Display Control " & fld.Properties("DisplayControl") & "  *"
                                oFile.writeline "--***********************"
                            Else
                                oFile.writeline "--***********************"
                                oFile.writeline "-- Field " & fld.Name & Space(15 - Len(fld.Name)) & "*"
                                oFile.writeline "-- Unknown Data Type " & fld.Type & " *"
                                oFile.writeline "-- Display Control " & fld.Properties("DisplayControl") & "  *"
                                oFile.writeline "--***********************"
                            End If
                        Case Else 'not catered for
                            strTypeName = "N/A"
                            oFile.writeline "--***********************"
                            oFile.writeline "-- Field " & fld.Name & Space(15 - Len(fld.Name)) & "*"
                            oFile.writeline "-- UNKNOWN Data Type " & fld.Type & " *"
                            oFile.writeline "--***********************"
                    End Select
                End If
            Next
            
            oFile.writeline " CONSTRAINT [PK_" & parTablename & "] PRIMARY KEY CLUSTERED"
            oFile.writeline "("
            oFile.writeline "    " & strPrimaryKey & " Asc "
            oFile.writeline ")WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON) ON [PRIMARY] "
            oFile.writeline ") ON [PRIMARY] "
            oFile.writeline "GO"
            oFile.writeline strConstraints
        'Else
        '    Debug.Print tdf.Name
        End If
    Next
    
    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing


End Function

Function getPrimaryKey(parTablename As String) As String
Dim dbs As DAO.Database, tdf As TableDef, idx As DAO.Index, strPKs As String, n As Long
On Error GoTo Catch_Error
    Set dbs = CurrentDb()
    Set tdf = dbs.TableDefs(parTablename)
    For Each idx In tdf.Indexes
        If idx.Primary Then
            For n = 0 To idx.Fields.Count - 1
                strPKs = strPKs & IIf(Len(strPKs) = 0, "", ", ") & "[" & idx.Fields(n).Name & "]"
            Next
            Exit For
        End If
    Next
    getPrimaryKey = strPKs
Proc_Exit:
    Set dbs = Nothing
    Exit Function
Catch_Error:
    MsgBox Err.Description, vbInformation, "Error"
    Resume Proc_Exit
    Resume
End Function

Function goRemove_DBO()
Dim dbs As DAO.Database, tdf As DAO.TableDef, n As Long, boolShowMessages As Boolean, strNewName As String
On Error GoTo Catch_Error
Set dbs = CurrentDb()
boolShowMessages = False

    For Each tdf In dbs.TableDefs
        If Left(tdf.Name, 4) = "dbo_" Then
            strNewName = Trim(Mid(tdf.Name, 5))
            If boolShowMessages Then
                Select Case MsgBox("About to rename table " & tdf.Name & " to " & strNewName & ". Do you want to suppress further messages?" & vbCrLf & vbCrLf _
                    & "Click OK to continue processing without warning messages, No to continue processing and continue with warning messages, or Cancel to stop the process.", vbYesNoCancel, "Continue rename process?")
                Case vbCancel
                    GoTo Proc_Exit
                Case vbYes
                    boolShowMessages = False
                End Select
            End If
            tdf.Name = Trim(Mid(tdf.Name, 5))
            
            n = n + 1
        End If
    Next tdf
    MsgBox n & " tables fixed.", vbInformation, "Remove dbo prefix"
Proc_Exit:
Set dbs = Nothing
Exit Function
Catch_Error:
    MsgBox Err.Description & vbCrLf & vbCrLf & "Cannot fix table names.", vbInformation, "Error: " & Err.Number
    Resume Proc_Exit
    Resume
End Function