View Single Post
  #2 (permalink)  
Old February 11th, 2005, 05:49 AM
JpJoe JpJoe is offline
Friend of Wrox
 
Join Date: Jan 2005
Location: , , United Kingdom.
Posts: 100
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Hi Mitch, You can create two tables and use these subs to get the data into access. Note - the table structures, adjust to your requirements. Also these routines assume that the data does not change! Post back If you need any help.


Code starts - - - - - -
Sub ImportData()
Dim strSheetName As String
Dim strFilename As String

strSheetName = "Data" 'Sheet name
strFilename = "C:\YourWorkbook.xls" 'Filrname and path

ImportExcelData strFilename, strSheetName ' call import sub

End Sub

Sub ImportExcelData(WorkbookPathName As String, SheetName As String)
'This routine needs reference to the Excel 9.0 object library
'Also note that this routine is hard coded to the task of importing
'the excel data in your fixed format. If the format changes then this
'routine will encounter problems.

On Error GoTo ImportExcelData_Err
'================
Dim rstParent As DAO.Recordset 'Declare Database objects
Dim rstChild As DAO.Recordset
Dim db As DAO.Database

Dim xls As Excel.Application 'Declare Excel Objects
Dim wkb As Excel.Workbook
Dim wkSh As Excel.Worksheet

Dim pID As Long ''We use the Ecell count variable to Exit sub if more than 2 rows are empty

Set xls = New Excel.Application 'Create Excel application and open specified workbook
xls.Workbooks.Open (WorkbookPathName)

Set wkb = xls.ActiveWorkbook 'Create references to the excel objects
Set wkSh = wkb.Sheets(SheetName)
wkSh.Activate 'and activate the worksheet

Set db = CurrentDb
Set rstParent = db.OpenRecordset("tbl_Parent", dbOpenDynaset)
Set rstChild = db.OpenRecordset("tbl_Child", dbOpenDynaset)

wkSh.Range("A3").Select 'First Row Of DATA (not headers or '============ parts)

Do While eCellCount < 2

    If Not IsNumeric(xls.ActiveCell.Offset(0, 2)) Then 'If the cell is NOT numeric then must be a parent
        rstParent.AddNew
        rstParent!Parent_ID = Nz(xls.ActiveCell, 0)
        rstParent!Parent_Substation = xls.ActiveCell.Offset(0, 1)
        rstParent!Parent_Recloser = Trim(Nz(xls.ActiveCell.Offset(0, 2), "None Specified!"))
        rstParent!Parent_Rating = Trim(Nz(xls.ActiveCell.Offset(0, 3), "None Specified"))
        pID = rstParent!Parent_DBID 'Create reference to this parent record
        rstParent.Update 'and update the recordset
        eCellCount = 0
    Else 'Add a child record to the last parent created
        rstChild.AddNew
        rstChild!Child_Parent_DBID = pID 'This child must belong to the last Parent rec created
        rstChild!Child_Number = xls.ActiveCell.Offset(0, 2)
        rstChild!Child_Rating = xls.ActiveCell.Offset(0, 3)
        rstChild.Update
    End If

    xls.ActiveCell.Offset(1, 0).Select 'Move to next row
    If IsEmpty(xls.ActiveCell) Then eCellCount = eCellCount + 1 'Increment the Empty Cell Count var

Loop

MsgBox "Data Loaded!"

xls.Quit
rstChild.Close
rstParent.Close
Set xls = Nothing
Set rstParent = Nothing
Set rstChild = Nothing

'================
Exit_ImportExcelData:
    xls.Quit
    rstParent.Close
    rstChild.Close
    Set xls = Nothing
    Set rstParent = Nothing
    Set rstChild = Nothing
    Exit Sub
ImportExcelData_Err:
    Select Case Err.Number
        Case 0 'Add Exceptions

        Case Else
            MsgBox "An unhandled error has occurred! (" & Err.Number & ")" & vbCr & vbCr & Err.Description _
                , vbExclamation + vbOKOnly _
                , "Import Excel Data" _
                , Err.HelpFile _
                , Err.HelpContext
            Resume Exit_ImportExcelData
    End Select
End Sub

Code ends - - - - - -

hth

Jon