ID: Q151566
The information in this article applies to:
SYMPTOMS
In some cases, you may want to create a Microsoft Access database from a Microsoft Excel for Windows 95 version 7.0 workbook, but are not able to use Access Links. While the preferred method of moving a Microsoft Excel workbook into Microsoft Access is to use Access Links, you can also use data access object (DAO).
CAUSE
The reasons for not being able to use Access Links include (but are not limited to) the following:
You can use data access objects (DAO)to create any version of a Microsoft Access database. Although this method is not as complete as Access Links, you can use it to create a Microsoft Access database from a Microsoft Excel workbook. This method should be used only if you are experienced with Visual Basic for Applications and are familiar enough with Microsoft Access databases 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 field and whether or not you want indexing.
MORE INFORMATION
Microsoft provides programming examples for illustration only, without warranty either expressed or implied, including, but not limited to, the implied warranties of merchantability and/or fitness for a particular purpose. This article assumes that you are familiar with the programming language being demonstrated and the tools used to create and debug procedures. Microsoft support professionals 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 needs. If you have limited programming experience, you may want to contact the Microsoft fee-based consulting line at (800) 936-5200. For more information about the support options available from Microsoft, please see the following page on the World Wide Web:
http://www.microsoft.com/support/supportnet/refguide/
NOTE: These requirements are similar to what would be required if you were transferring data using Access Links.
Please ensure that the workbook used has a list on each worksheet consisting of at least two columns.
The requirements are 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.
NOTE: Because modules, chart sheets, and dialog sheets are not part of the Worksheet collection, they will not affect the subroutine.
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.
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 Sub
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
For more information about creating indexes, click the Index tab in Microsoft Access Help, type the following text:
Indexes, creating
For more information about indexing, click Answer Wizard on the Help menu in Microsoft Access 7.0, type "Index" (without the quotation marks) in the Search box, and click "Decide if and when to use an index."
For more information about indexing, click Search on the Help menu in Microsoft Access version 2.0, type "Index" (without the quotation marks) in the Search box, click "Index (see also indexes)," and then click "Creating an Index" under Topics.
Additional query words: 7.00 7.00a 8.00 97 xl97
Keywords : kbprg kbdta kbdtacode KbVBA kbhowto
Version : WINDOWS:7.0,7.0a,97
Platform : WINDOWSLast Reviewed: May 18, 1999