Results 1 to 5 of 5
  1. #1
    Join Date
    Dec 2003
    Location
    Greenwood, IN
    Posts
    40

    Unanswered: Using Excel Object to import dynamic Worksheets

    I have a workbook with multiple worksheets. The number of worksheets and their names will vary, but the data is all the same layout.

    I've successfully been able to import the first worksheet. Is there a means of calculating the number of worksheets and then looping through appending each into a table?

    Currently: DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strFileName, intHeaders

    I realize I will have to use the Excel Object, any tips would be great. Thanks!
    Doug

  2. #2
    Join Date
    Dec 2002
    Location
    Préverenges, Switzerland
    Posts
    3,740
    here's my code primitive for this sort of stuff - it's only an outline and not complete and covers a specific situation where i have XLS cells defined by data type etc etc, but it should show you one possible approach.

    izy

    Code:
    Private Function HarvestOK() As Boolean
        'reads the values in cells defined in table Cells
        'writes the values to table tblHarvest
        'for each of the worksheets in the files in tbl.FileList
        'returns TRUE if successful, else FALSE
        On Error GoTo err_HarvestOK
        Dim dunFiles As Long                                'number of files harvested so far
        Dim totFiles As Long                                'total number of files to be harvested
        Dim sourceXL As Object
        Dim sourceWS As Excel.Worksheet
        Dim countWS As Integer
        Dim loopWS
        Dim wotRow As Integer
        Dim wotCol As Integer
        Dim dabs As DAO.Database
        Dim recCell As DAO.Recordset
        Dim recData As DAO.Recordset
        Dim recFile As DAO.Recordset
        Dim fld As DAO.Field
        Dim cData As String
        
        Set dabs = CurrentDb
        Set sourceXL = CreateObject("Excel.Application")                'create the XLS object & start Excel
        Set recCell = dabs.OpenRecordset("Cells")                       'recordset for the cells
        Set recData = dabs.OpenRecordset("tblHarvest")                  'recordset for the data
        Set recFile = dabs.OpenRecordset("FileList")                    'recordset for the list of files
        
        recFile.MoveLast
        recFile.MoveFirst
        totFiles = recFile.RecordCount + 1                              'get the number of files to be harvested
        recCell.MoveLast
        
        Do While Not recFile.EOF                                        'for each file in tbl.FileList
            dunFiles = dunFiles + 1                                     'increment file count
            pbUpdate dunFiles, totFiles                                 'update the progress bar
            sourceXL.Workbooks.Open recFile!fileSpec                    'open the spreadsheet
            countWS = 0
            For Each sourceWS In sourceXL.Worksheets
                countWS = countWS + 1
            Next
                
            For loopWS = 1 To countWS                                   'for each worksheet
                Set sourceWS = sourceXL.Worksheets(loopWS)              'set the worksheet
                recCell.MoveFirst                                       'go to the top of cell list
                    
                recData.AddNew                                          'add a record for this worksheet
                            
                Do While Not recCell.EOF                                'for each cell
                    wotRow = recCell!cpR                                'set row
                    wotCol = recCell!cpC                                'set column
                    cData = sourceWS.Cells(wotRow, wotCol).Value & " "  'get data
                    
                    
                    'handle data according to expected field type
                    
                    If recCell!cpIsBool Then                    'type is boolean
                        If IsNull(cData) Then
                            cData = False                               'NULL = FALSE
                        Else
                            If Len(LTrim$(RTrim$(cData))) = 0 Then
                                cData = False                           ' "  " = FALSE
                            Else
                                cData = True                            'else TRUE
                            End If
                        End If
                    Else
                        If recCell!cpIsNum Then                 'type is double
                            If IsNull(cData) Then
                                cData = 0                               'NULL = 0
                            Else
                                If Not IsNumeric(cData) Then
                                    cData = 0                           'not number = 0
                                End If
                            End If
                        Else                                    'type is text
                            cData = CStr(Nz(cData, " "))                'defaults to " "
                        End If
                    End If
                            
                    
                    recData.Fields(recCell!cpField) = cData             'place the data
                    
    
                    recCell.MoveNext                                    'get the next cell
                Loop
                
                recData!LINKfileID = recFile!fileSpec               'place the source file
                recData!fromSheet = loopWS                          'place the sheet number
                
                recData.Update                                      'save the data
            
            Next
            
            sourceXL.Workbooks.Close                                    'close the XLS
            recFile.MoveNext
        Loop
        
        HarvestOK = True                                                'the happy exit
        
    exit_HarvestOK:
    
        sourceXL.Application.Quit                                       'tidy up
        
        Set sourceWS = Nothing
        Set sourceXL = Nothing
        Set recCell = Nothing
        Set recData = Nothing
        Set recFile = Nothing
        Set dabs = Nothing
        
        Exit Function
        
    err_HarvestOK:
        HarvestOK = False                                               'the sad exit
        MsgBox "Error on file " & dunFiles & " - " & recFile!fileSpec & vbCrLf & err.Description, vbCritical + vbOKOnly, "Harvester.HarvestOK"
        Resume exit_HarvestOK
        
    End Function
    currently using SS 2008R2

  3. #3
    Join Date
    Dec 2003
    Location
    Greenwood, IN
    Posts
    40
    Thanks! I think this gives me enough to go on!

    Appreciate the help!
    Doug
    Doug

  4. #4
    Join Date
    Dec 2003
    Location
    Greenwood, IN
    Posts
    40

    Unhappy Read the excel file to get the worksheet names and cells?

    Unfortunately, I haven't been able to get this working. Your example is awesome - but it requires that you know the worksheets and cells and ranges. My problem is that I need to select a workbook and have the code determine the number and name of the worksheets with all of the ranges, then import each of them.
    Doug

  5. #5
    Join Date
    Dec 2002
    Location
    Préverenges, Switzerland
    Posts
    3,740
    my use was predefined data-gathering XLS, each with an arbitrary number of (identical) worksheets.
    i knew the structure and datatypes in advance so i could make table Cells
    Dir() got the filenames (all files in one directory) into table FileList
    the routine i posted did the rest.

    if you don't know the XLS structure in advance, how are you going to import?

    object browser shows stuff that might be worth poking around with:
    Names (Excel.Worksheet)
    Listnames (Excel.Range)
    ...but sorry - i have never had the need to play with ranges myself so can't help.

    izy
    currently using SS 2008R2

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •