asked on

Import Excel Worksheets into ms access with worksheet name

Dear Expert,

I have an excel file , this excel file contains so many worksheets, I have used successfully and thankfully the -below mentioned- code published in http://www.accessmvp.com/kdsnell/EXCEL_Import.htm , This code working perfect and importing all row data that I needs from each worksheets.

Since the number of worksheets in this excel file is more than 10 worksheets , I want to add the worksheet name in each row data imported.

Could you please help.

Regards

The code:

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, strTable 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:\Filename.xls with the actual path and filename
strPathFile = "C:\Filename.xls"

' Replace tablename with the real name of the table into which 
' the data are to be imported
strTable = "tablename"

' 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

' Open the EXCEL file and read the worksheet names into a collection
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 the table
For lngCount = colWorksheets.Count To 1 Step -1
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" & "A2:E"
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 strPathFile

Open in new window

End of code

Rey Obrero (Capricorn1)

test this

' add a text field to your destination table and name it "SheetName", then add line 54

50:' Import the data from each worksheet into the table
51:For lngCount = colWorksheets.Count To 1 Step -1
52: DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
53: strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" & "A2:E"
54: currentdb.execute "update " & strTable & " set SheetName='" & colWorksheets(lngCount) & "' where SheetName is null"
55:Next lngCount

Rey Obrero (Capricorn1)

change this line

currentdb.execute "update " & strTable & " set SheetName='" & colWorksheets(lngCount) & "' where SheetName is null"

with

currentdb.execute "update " & strTable & " set SheetName='" & colWorksheets(lngCount).name & "' where SheetName is null"

T B

ASKER

Dear Rey,

The last posted code , Return Run-Time error 424 - Object required.

Fyi please.

Regards.

Rey Obrero (Capricorn1)

which line?

T B

ASKER

The error occurred in Line number 4.

 For lngCount = colWorksheets.Count To 1 Step -1
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" & "A1:D"
            CurrentDb.Execute "update " & strTable & " set SheetName='" & colWorksheets(lngCount).Name & "' where SheetName is null"       
Next lngCount

Open in new window

ASKER CERTIFIED SOLUTION

Rey Obrero (Capricorn1)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

T B

ASKER

Dear Rey,

Having try your original code, it's working great.

Thanks a millions