Transfer Spreadsheet; Import Only UsedRange

  • Thread starter Thread starter ryguy7272
  • Start date Start date
R

ryguy7272

I am importing several worksheets into Access Tables. The code below is a
sample of what I use now:

DoCmd.SetWarnings False

' Andy - 1
DoCmd.RunSQL ("DELETE * FROM Andy;")
DoCmd.TransferSpreadsheet acImport, 8, "Andy", "C:\Documents and
Settings\rshuell\Desktop\Access Models\Up To Access\RVP Summary.xls", True,
"Andy!A5:AB300"

' Chris - 2
DoCmd.RunSQL ("DELETE * FROM Chris;")
DoCmd.TransferSpreadsheet acImport, 8, "Chris", "C:\Documents and
Settings\rshuell\Desktop\Access Models\Up To Access\RVP Summary.xls", True,
"Chris!A5:AB300"

‘so on and so forth…
DoCmd.SetWarnings True

I am wondering how to import only the used range in each Excel sheet because
some sheets have more rows than others, and these each week. Is there a
UsedRange property for Access like there is for Excel? Something along the
lines of:
Worksheets("Sheet1").Activate
ActiveSheet.UsedRange.Select


Thanks so much!!
Ryan----
 
Hi,
I think you can either open spreadsheet before import, determine used range
and then set last parameter of DoCmd.TransferSpreadsheet to that range. Or,
perhaps better, just import then whole sheet into temp table and then delete
empty records

--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com
 
I saw your post when looking for something else. I am actually still on the
steep learning curve with Access but I thought you might be interested in the
following code that I developed for a problem that I had. I started off
manually importing data from Excel worksheets and found that if the worksheet
had at some previous time had data below the real used range, Access imported
all the blank rows that had data deleted from them.
I found that I had to select all the rows below the data to the end of the
worksheet and use Clear All. (Not simply Clear contents but use menu item
Edit -> Clear -> All). This option is not available on mouse right click.

Anyway I developed the following code to do the work for me in Access.
Before using it, when in the Access VBA editor, select Tools -> References ->
and then Check the box against Microsoft Excel 10.0 Object Library.
(Depending on your version of Office it might be 9.0 for Office 2000, 10.0
for Office 2002, 11.0 for Office 2003.) (Make sure you actually CHECK THE
BOX, not just select the reference before clicking OK like I did the first
time and wondered why it did not work. Also I think you have to close and
re-open Access after selecting it and if moving the project to another
version of office you will probably have to repeat it.)

I am also interested in helpful comments from the Access experts because
while I have made it work for me, I am always interested in improvement.

Private Sub LoadFromXL_Click()
'Some of this code adapted from post by Ken Snell
'MVP - MS Access Forum July 2 2008

Dim strCurrProjPath As String
Dim objExcel As Object 'Excel.Application
Dim objWorkbook As Object 'Excel.Workbook
Dim objWorksheet As Object 'Worksheet
Dim strXlFileName As String 'Excel Workbook name
Dim strWorksheetName As String 'Excel Worksheet name
Dim objCell As Object 'Last used cell in column
Dim strUsedRange As String 'Used range

'Path of current Access project
strCurrProjPath = Application.CurrentProject.Path

'Assign Path and filename of XL file to variable
strXlFileName = strCurrProjPath & "\" & "Test Workbook.xls"

'Assign Excel application to a variable
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False 'Can be visible or not visible

'Open the Excel Workbook
Set objWorkbook = objExcel.Workbooks.Open(strXlFileName)

'Assign required worksheet to a variable
With objWorkbook
Set objWorksheet = .Worksheets(1)
End With

With objWorksheet
'Assign worksheet name to a string variable
strWorksheetName = .Name
'Find last used cell in Column A
Set objCell = .cells(.rows.Count, "A").End(xlup)
'Clear All from 1 row below data to end of worksheet.
'Avoids incorrect used range due to deleted data.
.range(objCell.Offset(1, 0), _
.cells(.rows.Count, "A")).EntireRow.Clear
End With

'Assign used range to a string variable.
'.Address(0,0) returns A1:F10 type address.
'Absolute address ($A$1:$F$1000) does not work in
'DoCmd.TransferSpreadsheet.....etc.
strUsedRange = objWorksheet.UsedRange.Address(0, 0)

'Turn off/Close in reverse order to setting/opening.
Set objCell = Nothing
Set objWorksheet = Nothing

'SaveChanges = False suppresses save message
objWorkbook.Close SaveChanges:=False
Set objWorkbook = Nothing

objExcel.Quit
Set objExcel = Nothing

DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE * FROM [Test Table];")

'Import the worksheet
DoCmd.TransferSpreadsheet acImport, 8, "Test Table", _
strXlFileName, True, strWorksheetName & "!" & strUsedRange

'Turn warnings back on or the remain off
'even in Access interactive mode
DoCmd.SetWarnings True
End Sub
 
Back
Top