Import Several Excel Workbooks; Create Several Tables

R

ryguy7272

I’ve used the code at this site before:
http://www.accessmvp.com/KDSnell/EXCEL_Import.htm

It is VERY useful. Ok, now on to the question. At one point, I thought I
saw code for importing several Excel Workbooks into several Access Tables.
For instance, if I have a folder with three Excel Workbooks, and each
Workbook has three sheets, how can I create nine Tables in Access? I though
I saw the code to do that at that link, but now I’m not seeing it… Is there
a way to do what I described above?

Thanks,
Ryan---
 
A

Alex Dybenko

Hi,
I think you can combine "Import Data from All Worksheets in a single EXCEL
File into Separate Tables via TransferSpreadsheet (VBA)" and "Import Data
from All EXCEL Files in a single Folder via TransferSpreadsheet (VBA)",
second one you need to read excel files names

--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com
 
K

Ken Snell [MVP]

ryguy7272 -

Per Alex' suggestion, you should be able to combine the different code
examples to do what you want. If you have questions, I'll monitor this
thread as well.
 
R

ryguy7272

Here's my feeble attempt:

Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

' Replace C:\Filename.xls with the actual path and filename
strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
strPathFile = Dir(strPathFile & "*.xls")
Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop
'
'Set colWorksheets = New Collection
'Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
' strPassword)
'For lngCount = 1 To objWorkbook.Worksheets.Count
' colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
'Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing


End Sub


Of course it doesn't work...

It fails on this line:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames

Message Reads: 'the action or method requires a Table name argument.'
I'm much better with Excel than with Access, but hopefully I'll be up to
speed with this database stuff soon. What am I missing?

Thanks,
Ryan---



--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


Ken Snell said:
ryguy7272 -

Per Alex' suggestion, you should be able to combine the different code
examples to do what you want. If you have questions, I'll monitor this
thread as well.
--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/
Click to expand...
 
J

JimBurke via AccessMonster.com

It looks like you forgot to get rid of some code and forgot to uncomment some
as well. You're trying to do the transferspreadsheet loop before you've
resolved the sheet names (you have this code again later on and that part
looks OK from what I can see). You don't need this first loop:
Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop
Click to expand...

Then right after that you have the code to get the sheet names and you appear
to have that code commented out. So get rid of that first transferspreadsheet
loop and uncomment the commented code and try it again.
Here's my feeble attempt:

Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

' Replace C:\Filename.xls with the actual path and filename
strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
strPathFile = Dir(strPathFile & "*.xls")
Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop
'
'Set colWorksheets = New Collection
'Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
' strPassword)
'For lngCount = 1 To objWorkbook.Worksheets.Count
' colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
'Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

End Sub

Of course it doesn't work...

It fails on this line:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames

Message Reads: 'the action or method requires a Table name argument.'
I'm much better with Excel than with Access, but hopefully I'll be up to
speed with this database stuff soon. What am I missing?

Thanks,
Ryan---
ryguy7272 -
Click to expand...
[quoted text clipped - 15 lines]
Click to expand...
 
R

ryguy7272

Ok, thanks Jim. Now I'm working with this:
Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strPathFile = Dir(strPathFile & "*.xls")

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

End Sub

I get a message that says 'Run-Time Error 1004: Find Red Cells.xls could not
be found'.
this line is highlighted:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)

Find Red Cells.xls is one of the files in the folder (sure you could have
guessed that). The message makes me think something is wrong with one of the
arguments in 'objExcel.Workbooks.Open'. F8-ing through the code didn't help.

I think I'm close now, but still stuck. I'll keep at it. If someone has
any idea of what to try next please share.

Thanks,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


JimBurke via AccessMonster.com said:
It looks like you forgot to get rid of some code and forgot to uncomment some
as well. You're trying to do the transferspreadsheet loop before you've
resolved the sheet names (you have this code again later on and that part
looks OK from what I can see). You don't need this first loop:
Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop
Click to expand...

Then right after that you have the code to get the sheet names and you appear
to have that code commented out. So get rid of that first transferspreadsheet
loop and uncomment the commented code and try it again.
Here's my feeble attempt:

Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

' Replace C:\Filename.xls with the actual path and filename
strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
strPathFile = Dir(strPathFile & "*.xls")
Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop
'
'Set colWorksheets = New Collection
'Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
' strPassword)
'For lngCount = 1 To objWorkbook.Worksheets.Count
' colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
'Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

End Sub

Of course it doesn't work...

It fails on this line:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames

Message Reads: 'the action or method requires a Table name argument.'
I'm much better with Excel than with Access, but hopefully I'll be up to
speed with this database stuff soon. What am I missing?

Thanks,
Ryan---
ryguy7272 -
Click to expand...
[quoted text clipped - 15 lines]
Thanks,
Ryan---
Click to expand...
Click to expand...
Click to expand...
 
J

JimBurke via AccessMonster.com

Unfortunately I've never needed to use Dir to get file names. I've always
presented the user with a file selection menu and selected one file at a time,
so I'm not sure how to make that part work. Hopefully one of the other
responders will take a look and know what to do there.
Ok, thanks Jim. Now I'm working with this:
Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strPathFile = Dir(strPathFile & "*.xls")

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

End Sub

I get a message that says 'Run-Time Error 1004: Find Red Cells.xls could not
be found'.
this line is highlighted:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)

Find Red Cells.xls is one of the files in the folder (sure you could have
guessed that). The message makes me think something is wrong with one of the
arguments in 'objExcel.Workbooks.Open'. F8-ing through the code didn't help.

I think I'm close now, but still stuck. I'll keep at it. If someone has
any idea of what to try next please share.

Thanks,
Ryan---
It looks like you forgot to get rid of some code and forgot to uncomment some
as well. You're trying to do the transferspreadsheet loop before you've
Click to expand...
[quoted text clipped - 92 lines]
Click to expand...
 
K

Ken Snell [MVP]

Try this code. I've added a loop for going through all the workbooks, and
I've added a workbook counter so that you import into unique table names for
each worksheet from each workbook.


Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
Dim intWorkbookCounter As Integer
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strPathFile = Dir(strPathFile & "*.xls")

intWorkbookCounter = 0

Do While strPathFile <> ""

intWorkbookCounter = intWorkbookCounter + 1

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
strPathFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

strPathFile = Dir()

Loop

End Sub


--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/


ryguy7272 said:
Ok, thanks Jim. Now I'm working with this:
Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As
Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strPathFile = Dir(strPathFile & "*.xls")

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames,
_
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

End Sub

I get a message that says 'Run-Time Error 1004: Find Red Cells.xls could
not
be found'.
this line is highlighted:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)

Find Red Cells.xls is one of the files in the folder (sure you could have
guessed that). The message makes me think something is wrong with one of
the
arguments in 'objExcel.Workbooks.Open'. F8-ing through the code didn't
help.

I think I'm close now, but still stuck. I'll keep at it. If someone has
any idea of what to try next please share.

Thanks,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


JimBurke via AccessMonster.com said:
It looks like you forgot to get rid of some code and forgot to uncomment
some
as well. You're trying to do the transferspreadsheet loop before you've
resolved the sheet names (you have this code again later on and that part
looks OK from what I can see). You don't need this first loop:
Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop
Click to expand...

Then right after that you have the code to get the sheet names and you
appear
to have that code commented out. So get rid of that first
transferspreadsheet
loop and uncomment the commented code and try it again.
Here's my feeble attempt:

Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As
Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

' Replace C:\Filename.xls with the actual path and filename
strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
strPathFile = Dir(strPathFile & "*.xls")
Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop
'
'Set colWorksheets = New Collection
'Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, ,
_
' strPassword)
'For lngCount = 1 To objWorkbook.Worksheets.Count
' colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
'Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile,
blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

End Sub

Of course it doesn't work...

It fails on this line:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames

Message Reads: 'the action or method requires a Table name argument.'
I'm much better with Excel than with Access, but hopefully I'll be up to
speed with this database stuff soon. What am I missing?

Thanks,
Ryan---

ryguy7272 -

[quoted text clipped - 15 lines]
Thanks,
Ryan---
Click to expand...
Click to expand...
Click to expand...
 
R

ryguy7272

Thanks Ken! It seems like I was close because the only difference I noticed
b/w my last post and your post was the counter, the do while…loop and the
strPathFile = Dir(), at the end. Unfortunately your new code is not working
for me. When it fires, all I get is a message which reads ‘Run time error
1004: Canada.xls could not’ be found. Check the spelling of the file name and
verify that the file location is current. Canada.xls is the first of three
files in my Ryan folder.

This line is yellow:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)

When I mouse over objWorkbook, I get objWorkbook = Nothing.

I did a bit of research on the 1004 error. This link seemed promising:
http://support.microsoft.com/default.aspx/kb/176699

Still can’t figure it out though.


What else can I try Ken?

Thanks,
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


Ken Snell said:
Try this code. I've added a loop for going through all the workbooks, and
I've added a workbook counter so that you import into unique table names for
each worksheet from each workbook.


Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
Dim intWorkbookCounter As Integer
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strPathFile = Dir(strPathFile & "*.xls")

intWorkbookCounter = 0

Do While strPathFile <> ""

intWorkbookCounter = intWorkbookCounter + 1

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
strPathFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

strPathFile = Dir()

Loop

End Sub


--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/


ryguy7272 said:
Ok, thanks Jim. Now I'm working with this:
Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As
Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strPathFile = Dir(strPathFile & "*.xls")

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames,
_
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

End Sub

I get a message that says 'Run-Time Error 1004: Find Red Cells.xls could
not
be found'.
this line is highlighted:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)

Find Red Cells.xls is one of the files in the folder (sure you could have
guessed that). The message makes me think something is wrong with one of
the
arguments in 'objExcel.Workbooks.Open'. F8-ing through the code didn't
help.

I think I'm close now, but still stuck. I'll keep at it. If someone has
any idea of what to try next please share.

Thanks,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


JimBurke via AccessMonster.com said:
It looks like you forgot to get rid of some code and forgot to uncomment
some
as well. You're trying to do the transferspreadsheet loop before you've
resolved the sheet names (you have this code again later on and that part
looks OK from what I can see). You don't need this first loop:

Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop

Then right after that you have the code to get the sheet names and you
appear
to have that code commented out. So get rid of that first
transferspreadsheet
loop and uncomment the commented code and try it again.

ryguy7272 wrote:
Here's my feeble attempt:

Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As
Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

' Replace C:\Filename.xls with the actual path and filename
strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
strPathFile = Dir(strPathFile & "*.xls")
Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop
'
'Set colWorksheets = New Collection
'Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, ,
_
' strPassword)
'For lngCount = 1 To objWorkbook.Worksheets.Count
' colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
'Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile,
blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

End Sub

Of course it doesn't work...

It fails on this line:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames

Message Reads: 'the action or method requires a Table name argument.'
I'm much better with Excel than with Access, but hopefully I'll be up to
speed with this database stuff soon. What am I missing?

Thanks,
Ryan---

ryguy7272 -

[quoted text clipped - 15 lines]
Thanks,
Ryan---
Click to expand...
Click to expand...
Click to expand...
 
K

Ken Snell [MVP]

Sorry... I didn't see a logic error in your original code involving the
inappropriate reuse of the strPathFile variable, so I didn't correct it. Try
this:

Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String, strFile As String
Dim strPassword As String
Dim strPathTable As String
Dim intWorkbookCounter As Integer
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strFile = Dir(strPathFile & "*.xls")

intWorkbookCounter = 0

Do While strFile <> ""

intWorkbookCounter = intWorkbookCounter + 1

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile & strFile, , _
blnReadOnly, , strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
strPathFile & strFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

strFile = Dir()

Loop

End Sub
--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/


ryguy7272 said:
Thanks Ken! It seems like I was close because the only difference I
noticed
b/w my last post and your post was the counter, the do while.loop and the
strPathFile = Dir(), at the end. Unfortunately your new code is not
working
for me. When it fires, all I get is a message which reads 'Run time error
1004: Canada.xls could not' be found. Check the spelling of the file name
and
verify that the file location is current. Canada.xls is the first of
three
files in my Ryan folder.

This line is yellow:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)

When I mouse over objWorkbook, I get objWorkbook = Nothing.

I did a bit of research on the 1004 error. This link seemed promising:
http://support.microsoft.com/default.aspx/kb/176699

Still can't figure it out though.


What else can I try Ken?

Thanks,
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


Ken Snell said:
Try this code. I've added a loop for going through all the workbooks, and
I've added a workbook counter so that you import into unique table names
for
each worksheet from each workbook.


Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As
Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
Dim intWorkbookCounter As Integer
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strPathFile = Dir(strPathFile & "*.xls")

intWorkbookCounter = 0

Do While strPathFile <> ""

intWorkbookCounter = intWorkbookCounter + 1

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
strPathFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

strPathFile = Dir()

Loop

End Sub


--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/


ryguy7272 said:
Ok, thanks Jim. Now I'm working with this:
Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As
Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strPathFile = Dir(strPathFile & "*.xls")

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, ,
_
strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile,
blnHasFieldNames,
_
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

End Sub

I get a message that says 'Run-Time Error 1004: Find Red Cells.xls
could
not
be found'.
this line is highlighted:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, ,
_
strPassword)

Find Red Cells.xls is one of the files in the folder (sure you could
have
guessed that). The message makes me think something is wrong with one
of
the
arguments in 'objExcel.Workbooks.Open'. F8-ing through the code didn't
help.

I think I'm close now, but still stuck. I'll keep at it. If someone
has
any idea of what to try next please share.

Thanks,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking
''Yes''.


:

It looks like you forgot to get rid of some code and forgot to
uncomment
some
as well. You're trying to do the transferspreadsheet loop before
you've
resolved the sheet names (you have this code again later on and that
part
looks OK from what I can see). You don't need this first loop:

Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop

Then right after that you have the code to get the sheet names and you
appear
to have that code commented out. So get rid of that first
transferspreadsheet
loop and uncomment the commented code and try it again.

ryguy7272 wrote:
Here's my feeble attempt:

Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As
Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim strPathTable As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

' Replace C:\Filename.xls with the actual path and filename
strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
strPathFile = Dir(strPathFile & "*.xls")
Do While Len(strPathFile) > 0
strPathFile = strPathFile & strPathFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames
strPathFile = Dir()
Loop
'
'Set colWorksheets = New Collection
'Set objWorkbook = objExcel.Workbooks.Open(strPathFile, ,
blnReadOnly, ,
_
' strPassword)
'For lngCount = 1 To objWorkbook.Worksheets.Count
' colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
'Next lngCount

' Close the EXCEL file without saving the file, and clean up the
EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile,
blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

End Sub

Of course it doesn't work...

It fails on this line:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strPathTable, strPathFile, blnHasFieldNames

Message Reads: 'the action or method requires a Table name argument.'
I'm much better with Excel than with Access, but hopefully I'll be up
to
speed with this database stuff soon. What am I missing?

Thanks,
Ryan---

ryguy7272 -

[quoted text clipped - 15 lines]
Thanks,
Ryan---
Click to expand...
Click to expand...
Click to expand...
 
J

JimBurke via AccessMonster.com

After a quick little test, I'm pretty sure that the strPath variable only has
the workbook name - it doesn't have the fully qualified file name with the
directory. You need one variable that keeps the directory name only and
another that you use to iterate thru the directory for each individual
workbook name. Something like this:

strDirName = "C:\Ryan\"
strPathFile = Dir(strDirName & "*.xls")

...

While
....

strPathFile = Dir()
Loop

When you need to reference a workbook, use strDirName & strPathFile, both
when opening the workbook and when doing the transferspreadsheet. e.g.

Set objWorkbook = objExcel.Workbooks.Open(strDirName & strPathFile....

If you check the value of strPath when you get the error you'll probably see
that it is the workbook name only, without the path in front of it. I think
this is right anyway!

Thanks Ken! It seems like I was close because the only difference I noticed
b/w my last post and your post was the counter, the do while…loop and the
strPathFile = Dir(), at the end. Unfortunately your new code is not working
for me. When it fires, all I get is a message which reads ‘Run time error
1004: Canada.xls could not’ be found. Check the spelling of the file name and
verify that the file location is current. Canada.xls is the first of three
files in my Ryan folder.

This line is yellow:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)

When I mouse over objWorkbook, I get objWorkbook = Nothing.

I did a bit of research on the 1004 error. This link seemed promising:
http://support.microsoft.com/default.aspx/kb/176699

Still can’t figure it out though.

What else can I try Ken?

Thanks,
Ryan---
Try this code. I've added a loop for going through all the workbooks, and
I've added a workbook counter so that you import into unique table names for
Click to expand...
[quoted text clipped - 245 lines]
Click to expand...
 
R

ryguy7272

This is fun, but frustrating too. With Ken's last post, two Sheets import,
two Tables are created, and then I get this...Run Time Error 91: Object
variable with block variable not set.

Here's the culprit:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile & strFile, , _
blnReadOnly, , strPassword)

I did a little troubleshooting... I deleted the workbook that was imported,
thinking maybe it was somehow corrupt, but I get the same behavior with the
next file in the folder. So, I deleted the next workbook. With only one
workbook in the folder, the code works. Seems like there is a failure to
move from one Excel workbook to the next. The Do While...Loop looks correct,
but somehow Access seems to be choking on it.

Any ideas?


Thanks for sticking with this!!
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


JimBurke via AccessMonster.com said:
After a quick little test, I'm pretty sure that the strPath variable only has
the workbook name - it doesn't have the fully qualified file name with the
directory. You need one variable that keeps the directory name only and
another that you use to iterate thru the directory for each individual
workbook name. Something like this:

strDirName = "C:\Ryan\"
strPathFile = Dir(strDirName & "*.xls")

...

While
....

strPathFile = Dir()
Loop

When you need to reference a workbook, use strDirName & strPathFile, both
when opening the workbook and when doing the transferspreadsheet. e.g.

Set objWorkbook = objExcel.Workbooks.Open(strDirName & strPathFile....

If you check the value of strPath when you get the error you'll probably see
that it is the workbook name only, without the path in front of it. I think
this is right anyway!

Thanks Ken! It seems like I was close because the only difference I noticed
b/w my last post and your post was the counter, the do while…loop and the
strPathFile = Dir(), at the end. Unfortunately your new code is not working
for me. When it fires, all I get is a message which reads ‘Run time error
1004: Canada.xls could not’ be found. Check the spelling of the file name and
verify that the file location is current. Canada.xls is the first of three
files in my Ryan folder.

This line is yellow:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)

When I mouse over objWorkbook, I get objWorkbook = Nothing.

I did a bit of research on the 1004 error. This link seemed promising:
http://support.microsoft.com/default.aspx/kb/176699

Still can’t figure it out though.

What else can I try Ken?

Thanks,
Ryan---
Try this code. I've added a loop for going through all the workbooks, and
I've added a workbook counter so that you import into unique table names for
Click to expand...
[quoted text clipped - 245 lines]
Thanks,
Ryan---
Click to expand...
Click to expand...
Click to expand...
 
K

Ken Snell [MVP]

Ok, missed moving one small section of code. This one should work:


Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String, strFile As String
Dim strPassword As String
Dim strPathTable As String
Dim intWorkbookCounter As Integer
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strFile = Dir(strPathFile & "*.xls")

intWorkbookCounter = 0

Do While strFile <> ""

intWorkbookCounter = intWorkbookCounter + 1

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile & strFile, , _
blnReadOnly, , strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
strPathFile & strFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

strFile = Dir()

Loop

If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

End Sub
--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/





ryguy7272 said:
This is fun, but frustrating too. With Ken's last post, two Sheets
import,
two Tables are created, and then I get this...Run Time Error 91: Object
variable with block variable not set.

Here's the culprit:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile & strFile, , _
blnReadOnly, , strPassword)

I did a little troubleshooting... I deleted the workbook that was
imported,
thinking maybe it was somehow corrupt, but I get the same behavior with
the
next file in the folder. So, I deleted the next workbook. With only one
workbook in the folder, the code works. Seems like there is a failure to
move from one Excel workbook to the next. The Do While...Loop looks
correct,
but somehow Access seems to be choking on it.

Any ideas?


Thanks for sticking with this!!
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


JimBurke via AccessMonster.com said:
After a quick little test, I'm pretty sure that the strPath variable only
has
the workbook name - it doesn't have the fully qualified file name with
the
directory. You need one variable that keeps the directory name only and
another that you use to iterate thru the directory for each individual
workbook name. Something like this:

strDirName = "C:\Ryan\"
strPathFile = Dir(strDirName & "*.xls")

...

While
....

strPathFile = Dir()
Loop

When you need to reference a workbook, use strDirName & strPathFile, both
when opening the workbook and when doing the transferspreadsheet. e.g.

Set objWorkbook = objExcel.Workbooks.Open(strDirName & strPathFile....

If you check the value of strPath when you get the error you'll probably
see
that it is the workbook name only, without the path in front of it. I
think
this is right anyway!

Thanks Ken! It seems like I was close because the only difference I
noticed
b/w my last post and your post was the counter, the do while.loop and
the
strPathFile = Dir(), at the end. Unfortunately your new code is not
working
for me. When it fires, all I get is a message which reads 'Run time
error
1004: Canada.xls could not' be found. Check the spelling of the file
name and
verify that the file location is current. Canada.xls is the first of
three
files in my Ryan folder.

This line is yellow:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, ,
_
strPassword)

When I mouse over objWorkbook, I get objWorkbook = Nothing.

I did a bit of research on the 1004 error. This link seemed promising:
http://support.microsoft.com/default.aspx/kb/176699

Still can't figure it out though.

What else can I try Ken?

Thanks,
Ryan---

Try this code. I've added a loop for going through all the workbooks,
and
I've added a workbook counter so that you import into unique table
names for
[quoted text clipped - 245 lines]
Thanks,
Ryan---
Click to expand...
Click to expand...
Click to expand...
 
R

ryguy7272

Works perfect! Thanks for seeing this through to the end Ken! I hope I see
that code on your web site sometime soon. As I recall, you've already
covered every other possible scenario. This seems to be the last piece.

Thanks so much!
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


Ken Snell said:
Ok, missed moving one small section of code. This one should work:


Sub Import()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String, strFile As String
Dim strPassword As String
Dim strPathTable As String
Dim intWorkbookCounter As Integer
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = False

strPathFile = "C:\Ryan\"
strPassword = "passwordtext"
blnReadOnly = True
strPassword = vbNullString
strFile = Dir(strPathFile & "*.xls")

intWorkbookCounter = 0

Do While strFile <> ""

intWorkbookCounter = intWorkbookCounter + 1

Set colWorksheets = New Collection

Set objWorkbook = objExcel.Workbooks.Open(strPathFile & strFile, , _
blnReadOnly, , strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL
objects
objWorkbook.Close False
Set objWorkbook = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
strPathFile & strFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

strFile = Dir()

Loop

If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

End Sub
--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/





ryguy7272 said:
This is fun, but frustrating too. With Ken's last post, two Sheets
import,
two Tables are created, and then I get this...Run Time Error 91: Object
variable with block variable not set.

Here's the culprit:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile & strFile, , _
blnReadOnly, , strPassword)

I did a little troubleshooting... I deleted the workbook that was
imported,
thinking maybe it was somehow corrupt, but I get the same behavior with
the
next file in the folder. So, I deleted the next workbook. With only one
workbook in the folder, the code works. Seems like there is a failure to
move from one Excel workbook to the next. The Do While...Loop looks
correct,
but somehow Access seems to be choking on it.

Any ideas?


Thanks for sticking with this!!
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


JimBurke via AccessMonster.com said:
After a quick little test, I'm pretty sure that the strPath variable only
has
the workbook name - it doesn't have the fully qualified file name with
the
directory. You need one variable that keeps the directory name only and
another that you use to iterate thru the directory for each individual
workbook name. Something like this:

strDirName = "C:\Ryan\"
strPathFile = Dir(strDirName & "*.xls")

...

While
....

strPathFile = Dir()
Loop

When you need to reference a workbook, use strDirName & strPathFile, both
when opening the workbook and when doing the transferspreadsheet. e.g.

Set objWorkbook = objExcel.Workbooks.Open(strDirName & strPathFile....

If you check the value of strPath when you get the error you'll probably
see
that it is the workbook name only, without the path in front of it. I
think
this is right anyway!


ryguy7272 wrote:
Thanks Ken! It seems like I was close because the only difference I
noticed
b/w my last post and your post was the counter, the do while.loop and
the
strPathFile = Dir(), at the end. Unfortunately your new code is not
working
for me. When it fires, all I get is a message which reads 'Run time
error
1004: Canada.xls could not' be found. Check the spelling of the file
name and
verify that the file location is current. Canada.xls is the first of
three
files in my Ryan folder.

This line is yellow:
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, ,
_
strPassword)

When I mouse over objWorkbook, I get objWorkbook = Nothing.

I did a bit of research on the 1004 error. This link seemed promising:
http://support.microsoft.com/default.aspx/kb/176699

Still can't figure it out though.

What else can I try Ken?

Thanks,
Ryan---

Try this code. I've added a loop for going through all the workbooks,
and
I've added a workbook counter so that you import into unique table
names for
[quoted text clipped - 245 lines]
Thanks,
Ryan---
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Excel Import Specification 2
How to create portable Excel applications? 2
email workbooks to three people 0
Import Several excel files into Several Access Tables 6
Data Access Page | Why use this feature? 3
Send Email with Access 2007 2
Import same Excel ranges from many workbooks 3
Break Large Table into Smaller, Seperate Tables? 2

Top