Placing Excel Data in an Access Table

What if, rather then linking or embedding your Excel spreadsheet, you wanted to create an Access table from scratch and load it with the data sitting in a worksheet? Using several programming techniques that you've already acquired in this book, you can easily achieve this task. Let's look at the VBA procedure that dynamically creates an Access table based on the Excel worksheet presented in Figure 15-19 (see the section "Linking an Excel Spreadsheet to a Microsoft Access Database"). Notice that this procedure connects to the Access database using ActiveX Data Objects (ADO) and the MicrosoftJet.OLEDB.4.0 provider. After the connection is established, the procedure creates a new Access table by using the Catalog and Table objects from the ADOX object library. Next, the fields are added to the table that correspond to the names of the spreadsheet columns. Notice that each text field specifies the maximum number of characters that it can accept. If the spreadsheet cell's length is larger than the specified field size, the error handler routine will display the Access built-in message appropriate for this error and the procedure will end.

The final task in the procedure is the data transfer operation. To perform this task, the procedure opens a Recordset object for an Access table.

Because you need to add records to the table, the procedure uses an adOpenKeyset cursor type. Now that the table is open, the procedure uses the For.. .Next loop to move through the Excel data rows, placing information found in each cell into the corresponding table field. Notice that a new record is added to an Access table with the AddNew method of the Recordset object. After copying data from all cells in each row, the procedure uses the Update method of the Recordset object to save the table record.

Sub AccessTbl_From_ExcelData() Dim conn As ADODB.Connection Dim cat As ADOX.Catalog Dim myTbl As ADOX.Table Dim rstAccess As ADODB.Recordset Dim rowCount As Integer Dim i As Integer

On Error GoTo ErrorHandler

' connect to Access using ADO Set conn = New ADODB.Connection conn.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & "Data Source = _ C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb;"

' create an empty Access table Set cat = New Catalog cat.ActiveConnection = conn Set myTbl = New ADOX.Table myTbl.Name = "TableFromExcel" cat.Tables.Append myTbl

' add fields (columns) to the table With myTbl.Columns

.Append "School No", adVarWChar, 7 .Append "Equipment Type", adVarWChar, 15 .Append "Serial Number", adVarWChar, 15 .Append "Manufacturer", adVarWChar, 20 End With

Set cat = Nothing

MsgBox "The table structure was created."

' open a recordset based on the newly created ' Access table

Set rstAccess = New ADODB.Recordset With rstAccess

.ActiveConnection = conn .CursorType = adOpenKeyset .LockType = adLockOptimistic .Open myTbl.Name End With

' now transfer data from Excel spreadsheet range

With Worksheets("mySheet")

rowCount = Range("A2:D7").Rows.Count

For i = 2 To rowCount + 1 With rstAccess

.AddNew ' add a new record to an Access table .Fields("School No") = Cells(i, 1).Text .Fields("Equipment Type") = Cells(i, 2).Value .Fields("Serial Number") = Cells(i, 3).Value .Fields("Manufacturer") = Cells(i, 4).Value .Update ' update the table record End With Next i End With

' close the Recordset and Connection object and remove them

' from memory rstAccess.Close conn.Close

Set rstAccess = Nothing Set conn = Nothing

AccessTbl_From_ExcelDataExit:

Exit Sub ErrorHandler:

MsgBox Err.Number & ": " & Err.Description Resume AccessTbl_From_ExcelDataExit End Sub

0 0

Post a comment