You are currently offline, waiting for your internet to reconnect

How to Create MS Access Database from MS Excel Using DAO

This article was previously published under Q151566
This article has been archived. It is offered "as is" and will no longer be updated.
In some cases, you may want to create a Microsoft Access database from aMicrosoft Excel for Windows 95 version 7.0 workbook, but are not able touse Access Links. While the preferred method of moving a Microsoft Excelworkbook into Microsoft Access is to use Access Links, you can also usedata access object (DAO).
The reasons for not being able to use Access Links include (but are notlimited to) the following:
  • Microsoft Access for Windows 95 version 7.0 is not installed on the computer.
  • There are not enough system resources to have Microsoft Excel and Microsoft Access loaded at the same time.
You can use data access objects (DAO)to create any version of a MicrosoftAccess database. Although this method is not as complete as Access Links,you can use it to create a Microsoft Access database from a Microsoft Excelworkbook. This method should be used only if you are experienced withVisual Basic for Applications and are familiar enough with Microsoft Accessdatabases to be able to edit the tables that are created by this code.

Some things that you may need to change are the data types of each fieldand whether or not you want indexing.
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. The code in this article will go through each worksheet in a MicrosoftExcel version 7.0 workbook and create a Microsoft Access table as specifiedin the code. There are several requirements for this code to functionproperly.

NOTE: These requirements are similar to what would be required if you weretransferring data using Access Links.

Please ensure that the workbook used has a list on each worksheetconsisting of at least two columns.

The requirements are as follows:

  • The data must be in column form with the field names in the first row. While the data may start in any row, this subroutine assumes that row 1 contains the field names and anything beneath row 1 is data for the table.
  • The data must be contiguous. Data missing within a record will not affect this subroutine adversely. However, after a blank row is encountered, the subroutine will assume that it has retrieved all of the data on the current worksheet. Likewise, once a blank column is encountered, the subroutine will assume that there are no more fields to the right.
  • Each column will be regarded as a field and each row will be regarded as a record. For example, the data should be set up as follows:
          Lname              Fname       EmpNum     SpouseName      Ebbeson            Frida          12         Dave      Edelstein          Alex           15      Edmonds            Cora           18         Paul      Eliasen            Deborah        22         Tom      Erickson           Gregory J      25         Lisa      Fallon             Scott          23      Feig               Wayne A.       35         Laurie      Fetty              Ellen M.       54         James						
    Please note that incomplete records are allowed.
The subroutine described below will do the following:
  • Declare variables. While this is not required, it is useful for syntax checking and reducing the amount of memory you use.
  • Turn off screen updating. This will make the subroutine run faster, plus you won't see the screen flash.
  • Create the database. The first argument specifies where the database will be, and what the name will be. The subroutine creates the new database in the same folder as the workbook and with the same name as the workbook (with an .mdb extension). If there is already a database with that name in the folder, a message box will appear asking if you want to delete the existing database. This is done by trapping "Error 3294 Database already exists."
  • Set up a loop to go through all the worksheets in the workbook.

    NOTE: Because modules, chart sheets, and dialog sheets are not part of the Worksheet collection, they will not affect the subroutine.
  • Within the worksheet loop, create a table based on the worksheet name.
  • Enter a loop that goes through each column in the data range and creates a field in the table with the same name as the column heading. In the Create Field section of the subroutine, you need to know what data type to assign the new field. To do this, the subroutine looks at the cell directly below it and it determines the NumberFormat property of the cell.

    A Select Case statement is entered that looks at the left most letter of the NumberFormat property. The data type is created, based on this letter. If an "m", "d", or "y" is returned, the data type is set to "dbDate." If "G" is returned, the cell below it is formatted to "General." If this is the case, you need to determine if the cell contains a number or text.

    To test to see if the cell contains a number or text, the subroutine attempts to divide the cell contents by 2. If the division fails, the routine drops to an error handler, which determines if "Type Mismatch" is the error. If this is the case, the field is set to dbText. If the division is successful, the subroutine drops to the next cell down to determine if that division will be successful. This is necessary because you need to determine that all the records contain a number for that field before you assign the data type to a number format. If all the divisions are successful, a data type of dbDouble is assigned.

    Because checking every cell in a column is a time consuming process. The subroutine checks for the presence of "Zip" or "Postal" in the column header. The reason for this is that Zip Codes and Postal Codes should be formatted as dbText. Even if you have all 5-digit Zip codes in your worksheet, you may want to add a 9-digit Zip code some day. If you have the field formatted as "dbDouble," you will receive an error message when trying to enter the Zip plus four value. Searching for "Zip" or "Postal" reduces processor time to create the field.

    If all the Select Case statements fail, the field is set to dbText.
  • After all the fields on a worksheet are created, all the data is added to the table.
  • After all the data is added to the table, the next worksheet is selected and the process starts over again until all the worksheets have been selected and saved as a table.
          Sub DataToAccess()     ' Declare variables.     Dim Db As database     Dim Rs As Recordset     Dim Td As TableDef     Dim Fd As Field     Dim x As Integer     Dim i As Integer     Dim f As Integer     Dim r As Integer     Dim c As Integer     Dim Message As String     Dim Title As String     Dim LastColumn As Integer     Dim NumberTest As Double     Dim StartCell As Object     Dim LastCell As Object     Dim Response     Dim CreateFieldFlag As Integer     Dim Flag As Integer     CreateFieldFlag = 0     Flag = 0     ' Turn off Screen Updating.     Application.ScreenUpdating = False     On Error GoTo ErrorHandler     ' Create the database.     ' This line will create an Microsoft Access 2.0 database. To vary the     ' version of the database, change the "dbVersion" constant.     ' See "CreateDatabase" in online Help for more information.     ' The database will be created in the same folder as the     ' activeworkbook.     Set Db = workspaces(0).CreateDatabase(ActiveWorkbook.Path & "\" & _        Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) _        & ".mdb", dbLangGeneral, dbVersion20)     ' Loop through all the worksheets in the workbook.     For i = 1 To Worksheets.Count        ' Select the "i th" worksheet and Cell "A1."        ' In this example, you need column headers in the first row.        ' These headers will become field names.        Worksheets(i).Select        Range("A1").Select        ' If the ActiveCell is blank, open a message box.        If ActiveCell.Value = "" Then            Message = "There is no data in the active cell: " & _                ActiveSheet.Name & "!" & ActiveCell.Address & Chr(10) & _                "Please ensure that all your worksheets have data on " & _                "them " & Chr(10) & _                "and the column headers start in cell A1" & Chr(10) & _                Chr(10) & "This process will now end."            Title = "Data Not Found"            MsgBox Message, , Title            Exit Sub        End If        ' Create a new Table, and use the Worksheet Name as the        ' Table Name.        Set Td = Db.CreateTableDef(Worksheets(i).Name)        ' Find the number of fields on the sheet and store the number        ' of the last column in a variable.        Selection.End(xlToRight).Select        LastColumn = Selection.Column        ' Select the current region. Then find what the address        ' of the last cell is.        Selection.CurrentRegion.Select        Set LastCell = Range(Right(Selection.Address, _            Len(Selection.Address) - _            Application.Search(":", Selection.Address)))        ' Go back to cell "A1."        Range("A1").Select        ' Enter a loop that will go through the columns and        ' create fields based on the column header.        For f = 1 To LastColumn            Flag = 0            ' Enter a select case statement to determine            ' the cell format.            Select Case Left(ActiveCell.Offset(1, 0).NumberFormat, 1)                Case "G"    'General format                    ' The "General" format presents a special problem.                    ' See above discussion for explanation                    If ActiveCell.Value Like "*Zip*" Then                        Set Fd = Td.CreateField(ActiveCell.Value, _                            dbText)                        Fd.AllowZeroLength = True                        r = LastCell.Row - 1                        Flag = 1                    Else                        If ActiveCell.Value Like "*Postal*" Then                            Set Fd = Td.CreateField(ActiveCell.Value, _                                dbText)                            Fd.AllowZeroLength = True                            r = LastCell.Row - 1                            Flag = 1                        End If                    End If                    ' Set up a text to determine if the field contains                    ' "Text" or "Numbers."                    For r = 1 To LastCell.Row - 1                        If Flag = 1 Then r = LastCell.Row                        CreateFieldFlag = 1                        NumberTest = ActiveCell.Offset(r, 0).Value / 2                    Next r                    ' If we get all the way through the loop without                    ' encountering an error, then all the values are                    ' numeric, and we assign the data type to be "dbDouble"                    If Flag = 0 Then                        Set Fd = Td.CreateField(ActiveCell.Value, dbDouble)                    End If                ' Check to see if the cell below is formatted as a date.                Case "m", "d", "y"                    Set Fd = Td.CreateField(ActiveCell.Value, dbDate)                ' Check to see if the cell below is formatted as currency.                Case "$", "_"                    Set Fd = Td.CreateField(ActiveCell.Value, dbCurrency)                ' All purpose trap to set field to text.                Case Else                    Set Fd = Td.CreateField(ActiveCell.Value, dbText)                End Select            ' Append the new field to the fields collection.            Td.Fields.Append Fd            ' Move to the right one column.            ActiveCell.Offset(0, 1).Range("A1").Select        ' Repeat the procedure with the next field (column).        Next f        ' Append the new Table to the TableDef collection.        Db.tabledefs.Append Td        ' Select Cell "A2" to start the setup for moving the data from        ' the worksheet to the database.        Range("A2").Select        ' Define the StartCell as the Activecell. All record addition        ' will be made relative to this cell.        Set StartCell = Range(ActiveCell.Address)        ' Open a recordset based on the name of the activesheet.        Set Rs = Db.OpenRecordset(Worksheets(i).Name)        ' Loop through all the data on the sheet and add it to the        ' recordset in the database.        For x = 0 To LastCell.Row - 2            Rs.AddNew            For c = 0 To LastColumn - 1                Rs.Fields(c) = StartCell.Offset(x, c).Value            Next c            Rs.Update        Next x     ' Repeat the process for the next worksheet in the workbook.     Next i     Application.ScreenUpdating = True     Exit SubErrorHandler:     Select Case Err        Case 3204   ' Database already exists.           Message = "There has been an error creating the database." & _                Chr(10) & _                Chr(10) & "Error Number: " & Err & _                Chr(10) & "Error Description: " & Error() & _                Chr(10) & _                Chr(10) & "Would you like to delete the existing" & _                "database:" & Chr(10) & _                Chr(10) & ActiveWorkbook.Path & "\" & _                Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & _                ".mdb"            Title = "Error in Database Creation"            Response = MsgBox(Message, vbYesNo, Title)            If Response = vbYes Then                Kill ActiveWorkbook.Path & "\" & _                  Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) -4) _                  & ".mdb"                Message = ""                Title = ""                Resume            Else                Message = "In order to run this procedure you need" & _                    Chr(10) & "to do ONE of the following:" & _                    Chr(10) & _                    Chr(10) & "1.  Move the existing database to a " & _                    "different directory, or " & _                    Chr(10) & "2.  Rename the existing database, or" & _                    Chr(10) & "3.  Move the workbook to a different " & _                    "directory, or" & _                    Chr(10) & "4.  Rename the workbook"                Title = "Perform ONE of the following:"                MsgBox Message, , Title                Message = ""                Title = ""                Exit Sub            End If        ' Check to see if the error was Type Mismatch. If so, set the        ' file to dbText.        Case 13 ' Type mismatch.            If CreateFieldFlag = 1 Then                Set Fd = Td.CreateField(ActiveCell.Value, dbText)                Fd.AllowZeroLength = True                Flag = 1                r = LastCell.Row - 1                CreateFieldFlag = 0                Resume Next            Else                Message = "You have a ""Type Mismatch"" in the code" _                    & Chr(10) _                    & Chr(10) & "Error Number: " & Err _                    & Chr(10) & "Error Description: " & Error() _                    & Chr(10) _                    & Chr(10) & "This procedure will close."                Title = "Type Mismatch"                MsgBox Message, , Title                Message = ""                Title = ""            End If        ' For any other error, display the error.        Case Else           Message = "An error has occured in the procedure." _                & Chr(10) _                & Chr(10) & "Error Number: " & Err _                & Chr(10) & "Error Description: " & Error()            Title = "An error has occured"            MsgBox Message, , Title            Message = ""            Title = ""     End Select     End Sub

Microsoft Access 97

For more information about creating indexes, click the Index tab inMicrosoft Access Help, type the following text:
Indexes, creating
and then double-click the selected text to go to the "Create an index tofind and sort records faster."

Microsoft Access 7.0

For more information about indexing, click Answer Wizard on the Help menuin Microsoft Access 7.0, type Index in theSearch box, and click "Decide if and when to use an index."

Microsoft Access 2.0

For more information about indexing, click Search on the Help menu inMicrosoft Access version 2.0, type Index inthe Search box, click "Index (see also indexes)," and then click "Creatingan Index" under Topics.
7.00a 8.00 97 xl97 XL

Article ID: 151566 - Last Review: 12/04/2015 14:47:52 - Revision: 4.0

Microsoft Excel 97 Standard Edition, Microsoft Excel 95 Standard Edition

  • kbnosurvey kbarchive kbdtacode kbhowto kbprogramming KB151566