PDA

View Full Version : Export To Access



jmenche
07-20-2006, 06:46 AM
Howdy,

I thought this was easy but I've been surfing the web for a while with no definitive answer.

I have 1 workbookwith multiple worksheets. All of the worksheets are the same. I would like to export all of the sheets to an access table. Assume that a db and a table exists already.

Can someone help out?

Thanks.

Norie
07-20-2006, 08:09 AM
Something like this perhaps?

Note this code imports into seperate tables but you could just change objXLWS.Name to the name of the existing table.


Sub MultiWStoAccess()
Dim objXL As Object
Dim objXLWB As Object
Dim objXLWS As Object
Dim objXLRNG As Object
Dim MyBook As String

MyBook = "C:\Papers\MultiWStoAccess.xls" ' change to name of your workbook

Set objXL = CreateObject(, "Excel.Application")

Set objXLWB = objXL.workbooks.Open(MyBook)

For Each objXLWS In objXLWB.Worksheets

strRange = objXLWS.Name & "!"

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, objXLWS.Name, MyBook, True, strRange

Next

Set objXLWB = Nothing
Set objXL = Nothing

End Sub

jmenche
07-20-2006, 08:20 AM
Thanks Norie!

I do get an error message when I try to run the code though :-(

It tells me that "Argument not optional" and highlights the Set objXL line.

Norie
07-20-2006, 08:35 AM
My bad.:oops:

It's old code and I've not tested it for a while.

If I recall the last time I was using it I was using GetObject not CreateObject.

Try just removing the , from that line.

This I tested.:)


Sub MultiWStoAccess()
Dim objXL As Object
Dim objXLWB As Object
Dim objXLWS As Object
Dim objXLRNG As Object
Dim MyBook As String

MyBook = "C:\My Documents\MultiWStoAccess.xls" ' change to name of your workbook

Set objXL = CreateObject("Excel.Application")

Set objXLWB = objXL.workbooks.Open(MyBook)

For Each objXLWS In objXLWB.Worksheets

strRange = objXLWS.Name & "!"

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, objXLWS.Name, MyBook, True, strRange

Next

Set objXLWB = Nothing
Set objXL = Nothing

End Sub