Import Multiple Sheets From Excel Into Access

[Kelly Armstrong]

Hi,

I am very new to VBA and am trying to set up an import from excel into access. Both are the 2010 version. I pulled the code I am using from a previous thread posted by a user trying to do what I want to do. The problem I am having is that every time I try to run the code I get a message saying "Compile Error: Invalid Outside Procedure" and the file path is highlighted. Any advice on what I am doing wrong would be greatly appreciated. Below is the code I am using. Thanks.

 

Option Compare Database



Dim excelapp As New Excel.Application
Dim excelbook As New Excel.Workbook
Dim excelsheet As New Excel.Worksheet
Dim intNoOfSheets As Integer, intCounter As Integer
Dim strFilePath As String, strLastDataColumn As String
Dim strLastDataRow As String, strLastDataCell As String
  
strFilePath = "S:\share\Innoware Quality System\Data\Ridigity\2011 Rigidity\2011 Performa Rigidity.xlsx"
  
Set excelbook = excelapp.Workbooks.Open(strFilePath)
  
intNoOfSheets = excelbook.Worksheets.Count
  
For intCounter = 1 To intNoOfSheets
  excelbook.Worksheets(intCounter).Activate
    'The next 3 lines will obtain the last data cell reference for each Worksheet
    strLastDataColumn = Chr(Selection.SpecialCells(xlLastCell).Column + 64)
    strLastDataRow = Selection.SpecialCells(xlLastCell).Row
    strLastDataCell = strLastDataColumn & strLastDataRow    'e.g. J123
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel14, "RigidityResultsExcelImport", strFilePath, False, _
                 excelbook.Worksheets(intCounter).Name & "!A1:" & strLastDataCell
Next
  
excelbook.Close
excelapp.Quit
Set excelapp = Nothing

[Don Dufau]

You need to put the code into a subroutine or function. Add Public Sub ImportData before the first Dim statement, and End Sub to the end of the code block.

[Kelly Armstrong]

Well since I first posted this I have spent a lot of time working on it. It still will not function properly though. When I try to step into it, it stops at the highlighted line of code and give me this error: Run time error 1004. Excel cannot access '2011 Rigidity' The document may be read only or encrypted. But the document is not read only nor encrypted. This is what I have so far:

Public Sub importing()
Dim excelapp As New Excel.Application
Dim excelbook As New Excel.Workbook
Dim excelsheet As New Excel.Worksheet
Dim intNoOfSheets As Integer, intCounter As Integer
Dim strFilePath As String, strLastDataColumn As String
Dim strLastDataRow As String, strLastDataCell As String
  
  'The following is the path to the Excel file to open and import from
strFilePath = "S:\share\Innoware Quality System\Data\Ridigity\2011 Rigidity"
  
  'The following opens the excel workbook & counts the tabs
This is where the Debug option takes me to>>[B]Set excelbook = excelapp.Workbooks.Open(strFilePath)[/B]  
intNoOfSheets = excelbook.Worksheets.Count
  
For intCounter = 1 To intNoOfSheets
  excelbook.Worksheets(intCounter).Activate
  
    'The next 3 lines will obtain the last data cell reference for each Worksheet
    strLastDataColumn = Chr(Selection.SpecialCells(xlLastCell).Column + 64)
    strLastDataRow = Selection.SpecialCells(xlLastCell).Row
    strLastDataCell = strLastDataColumn & strLastDataRow    'e.g. J123
      
      'The next line will import the data from excel into Access, into the table "ImportedRigidityResults"
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "ImportedRigidityResults", strFilePath, False, _
                 excelbook.Worksheets(intCounter).Name & "!A1:" & strLastDataCell
Next
  
excelbook.Close
excelapp.Quit
Set excelapp = Nothing

End Sub

[Don Dufau]

I just used this code to Import a mutli page spreadsheet of my own. The two things I had to do to get it to run were: Added a Reference to Microsoft Excel 12.0 Object Library and then I also added the extension to the File name in the variable strFilePath (.xls)

[Kelly Armstrong]

Ok, I added the .xls, now the code runs through until the point where it is supposed to find the last used cell in each worksheet. The error code I get is : "Run-time '91': Object variable or with block variable not set. Then it highlights the noted line of code and dies.

Public Sub importing()
Dim excelapp As New Excel.Application
Dim excelbook As New Excel.Workbook
Dim excelsheet As New Excel.Worksheet
Dim intNoOfSheets As Integer, intCounter As Integer
Dim strFilePath As String, strLastDataColumn As String
Dim strLastDataRow As String, strLastDataCell As String
  
  'The following is the path to the Excel file to open and import from
strFilePath = "S:\share\Innoware Quality System\Data\Ridigity\2011 Rigidity\2011 Performa Rigidity.xls"
  
  'The following opens the excel workbook & counts the tabs
Set excelbook = excelapp.Workbooks.Open(strFilePath)
  
intNoOfSheets = excelbook.Worksheets.Count
  
For intCounter = 1 To intNoOfSheets
  excelbook.Worksheets(intCounter).Activate
  
    'The next 3 lines will obtain the last data cell reference for each Worksheet
    [U][U][U]The code dies here >>[B]strLastDataColumn = Chr(Selection.SpecialCells(xlLastCell).Column + 64)[/B][/U][/U][/U]    strLastDataRow = Selection.SpecialCells(xlLastCell).Row
    strLastDataCell = strLastDataColumn & strLastDataRow    'e.g. J123
      
      'The next line will import the data from excel into Access, into the table "ImportedRigidityResults"
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "ImportedRigidityResults", strFilePath, False, _
                 excelbook.Worksheets(intCounter).Name & "!A1:" & strLastDataCell
Next
  
excelbook.Close
excelapp.Quit
Set excelapp = Nothing

End Sub

[Don Dufau]

That's unusual, I'm not recieving any errors at that point. If all of the data on your worksheets is the same size you could just remove that code and set the size of the range in the DoCmd line.

[Kelly Armstrong]

Unfortunately, the size of the data on each worksheet varies and so to eliminate blank results from being imported, I need the code to find the last used cell and import everything up to that point.