Importing Excel - Update table field with the worksheet name

[maggiemago3]

I am trying to import several excel files with several worksheets/tabs in each file. The names and number of Files and Tabs will be unknown. The column formats however, will all be the same. (These files are collected from various sources at different times of the year and must be consolidated). I've taken 2 approaches to this, both using code from accessmvp.com. The first approach is to import all files and worksheets directly into a master table. The second approach is to import all files into the database, creating a seperate table for each worksheet.

Both codes work great as I am able to collect all of the data. however, I get stuck, when trying to include a column that has the worksheet name. (At some point down the road I will need to export these files in the format, meaning name and number of worksheets, I recieved them, hence the need to be able to collect the names). How can I include the worksheet name in each imported recordset?

Below are the codes I am using:

Import Data from All Worksheets in All EXCEL Files in a single Folder into Master Table via TransferSpreadsheet (VBA)
Dim blnHasFieldNames As
Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim intWorkbookCounter
As Integer
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As
Object
Dim colWorksheets As Collection
Dim strPath As String, strFile As
String
Dim strPassword 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

' Change this next line to True if the first row in EXCEL worksheet
' has field
names
blnHasFieldNames = True
' Replace
C:\MyFolder\ with the actual path to the folder that holds the EXCEL
files
strPath = "C:\MyFolder\"

' Replace
passwordtext with the real password;
' if there is no password,
replace it with vbNullString constant


' (e.g., strPassword =
vbNullString)
strPassword = "vbNullString"

blnReadOnly =
True ' open EXCEL file in read-only mode

strFile = Dir(strPath & "*.xls")

intWorkbookCounter = 0

Do While strFile <> ""
intWorkbookCounter = intWorkbookCounter + 1
Set colWorksheets = New Collection
Set objWorkbook =
objExcel.Workbooks.Open(strPath & 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, _
strPath
& strFile, blnHasFieldNames, _
colWorksheets(lngCount)
& "$"
Next lngCount

' Delete the
collection
Set colWorksheets = Nothing
'
Uncomment out the next code step if you want to delete the
' EXCEL
file after it's been imported
' Kill strPath & strFile

strFile = Dir()

Loop


--------------------------------------------------------------------------------------------------------
Import Data from All Worksheets in All EXCEL Files in a single Folder into Separate Tables via TransferSpreadsheet (VBA)

Generic code to import the data from
all worksheets in all EXCEL files in a single folder. Each worksheet's data will
be imported into a separate table whose name is 'tbl' plus the worksheet name
plus an integer value that represents a "counter" for the workbooks
(e.g., "tblWorksheetName1").

Dim blnHasFieldNames As
Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim intWorkbookCounter
As Integer
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As
Object
Dim colWorksheets As Collection
Dim strPath As String, strFile As
String
Dim strPassword 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

' Change this next
line to True if the first row in EXCEL worksheet
' has field
names
blnHasFieldNames = False

' Replace
C:\MyFolder\ with the actual path to the folder that holds the EXCEL
files
strPath = "C:\MyFolder\"

' Replace
passwordtext with the real password;
' if there is no password,
replace it with vbNullString constant
' (e.g., strPassword =
vbNullString)
strPassword = "passwordtext"

blnReadOnly =
True ' open EXCEL file in read-only
mode

strFile = Dir(strPath &
"*.xls")

intWorkbookCounter = 0

Do While strFile <>
""

intWorkbookCounter = intWorkbookCounter + 1

Set
colWorksheets = New Collection

Set objWorkbook =
objExcel.Workbooks.Open(strPath & 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, _
strPath
& strFile, blnHasFieldNames, _
colWorksheets(lngCount)
& "$"
Next lngCount

' Delete the
collection
Set colWorksheets = Nothing
'
Uncomment out the next code step if you want to delete the
' EXCEL
file after it's been imported
' Kill strPath & strFile

strFile = Dir()

Loop

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

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

[ssanfu]

It seems to me, looking at the import code, you have the worksheet name of the Excel worksheets in a collection.

colWorksheets.Add objWorkbook.Worksheets(lngCount).Name

Use an update query, something like:

   sSQL = "UPDATE YourTable"
   sSQL = sSQL & " SET YourTable.WorksheetName = '" & colWorksheets(lngCount) & "'"
   sSQL = sSQL & " WHERE IsNull(YourTable.WorksheetName);"
   CurrentDb.Execute sSQL, dbFailOnError

Change "YourTable" and "YourTable.WorksheetName" to the names of your import table and the field for the worksheet name.

Maybe this code could go the next line after the line
DoCmd.TransferSpreadsheet acImport,..............