Insert Sheet name into collection object required

[Thompyt]

The collection thing is throwing me off. I am trying to insert the sheet name into Cell F5 through F256. I get Object required 424 at ***

Dim ObjExcel As Object, objWB As Object,
Dim lngCnt As Long, ShtCnt As Long
DIM strPathFile As String
Dim  blnReadOnly As Boolean
Dim colWshts As Collection

blnReadOnly = False
strPathFile 'c:\Temp\Excelworkbook.xlsx"  ' Put the right name and path

    Set colWshts = New Collection    Set objWb = ObjExcel.Workbooks.Open(strPathFile, , blnReadOnly)   'Opens the workbook
                
        For lngCnt = 1 To objWB.Worksheets.Count                                                   ' Counts the worksheets from 1 until last worksheet
            colWshts .Add objWB.Worksheets(lngCount).Name                                     ' Gets the active sheet name + sheet number
                For ShtCnt = 5 To 256                                                                          ' Sets count starting at 5
 ***              colWshts (lngCnt).Range("F" & ShtCnt) = colWshts (lngCnt).Name       ' Intent is to insert the sheet name into active worksheet from F5 to F256 for each active sheet
                Next ShtCnt                                                                                          ' Loops count until 256 then steps to next line 
        Next lngCnt                                                                                                   ' Loops until the last worksheet name + # is found (End of Worksheets) then steps to next line

[Micron]

Don't you need to specify the sheet and the range? colWshts (as a collection) does not have a range object.

[June7]

Why are you using collection object variable? It is not needed just to loop worksheet names. The workbook is a collection of worksheets. Consider:

    Dim objXL As New Excel.Application
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    
    'objXL.Visible = True

    Set wkb = objXL.Workbooks.Open("C:\Users\Owner\June\MyStuff\ComputerInfo.xlsx")

    For Each wks In wkb.worksheets
        If wks.Index > 4 Then
            Debug.Print wks.Name & " : " & wks.Index 'or do something else
        End If
    Next

   'Tidy up
   objXL.DisplayAlerts = False
   wkb.Close
   Set wkb = Nothing
   objXL.Quit
   Set objXL = Nothing

or this loop:

    For x = 5 To 256
         wkb.worksheets("Sheet1").Range("F" & x).Value = wkb.worksheets(x).Name
    Next

[accesstos]

Indeed, you don't need an extra collection, not even a loop for each cell.

Try:

        For lngCnt = 1 To objWB.Worksheets.Count             ' Counts the worksheets from 1 until last worksheet
              With objWB.Worksheets(lngCnt)
 ***              .Range("F5:F255").Cells.Value =  .Name        ' Insert the sheet name into active worksheet from F5 to F256 for each active sheet
              End With
        Next lngCnt

[Thompyt]

I am using the collection to import the worksheet contents into an excel table. All the headers and data formats are the same across the worksheets. Much easier to import than to go 1 by 1 importing and appending the table. I was thinking that ObjExcel, objWb would be the object to point to. I added a Workbook and worksheet Dim along with @accesstos code. It does paste the worksheet name into the cells within the range specified but fails out when adding the next sheet. at the " DoCmd.TransferSpreadsheet" line

Private Sub OpenExcel_Click()

Dim ObjExcel As Object, objWk  As Object, f As Object
Dim strFile As String, strFolder As String, strPathFile As String, strTable As String
Dim varItem As Variant
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCnt As Long
Dim colWorksheets As Collection
Dim WBk As Workbook, WSht As Worksheet


' Establish an EXCEL application object
On Error Resume Next
 
    Set ObjExcel = GetObject(strPathFile, "Excel.Application")
        If Err.Number <> 0 Then
    Set ObjExcel = CreateObject("Excel.Application")
          blnEXCEL = True
        End If
Err.Clear
 
On Error GoTo 0
' True if the first row in EXCEL worksheet has field names
    blnHasFieldNames = True
 
' Opens Selection Box to select file
 Set f = Application.FileDialog(1)
       f.AllowMultiSelect = False
 
    If f.Show Then
        For Each varItem In f.SelectedItems
            strFile = Dir(varItem)
            strFolder = Left(varItem, Len(varItem) - Len(strFile))
        Next
    End If
   
    If strFile = "" Then
        MsgBox "User pressed CANCEL"
           Exit Sub
    End If
 
    strTable = Left(strFile, InStr(strFile, ".") - 1)  '  Table name without the .xlsx  into which the data are to be imported
   
    strPathFile = strFolder & strFile
 
    blnReadOnly = False ' open EXCEL file in read-only mode
 
' Open the EXCEL file and read the worksheet names into a collection
    Set colWorksheets = New Collection
    Set wb = ObjExcel.Workbooks.Open(strPathFile, , blnReadOnly)
    Set objWk = ObjExcel.Workbooks.Open(strPathFile, , blnReadOnly)
        For lngCnt = 1 To objWk.Worksheets.Count
            colWorksheets.Add objWk.Worksheets(lngCnt).Name
            Set WSht = objWk.Worksheets(lngCnt)
                With WSht
                    .Range("F5:F255").Cells.Value = .Name         ' Insert the sheet name into active worksheet from F5 to F256 for each active sheet
                End With
        Next lngCnt
        
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
    objWk.Close False
    Set objWk = Nothing
    If blnEXCEL = True Then ObjExcel.Quit
    Set ObjExcel = Nothing
 
' Import the data from each worksheet into the table
        For lngCnt = colWorksheets.Count To 1 Step -1
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCnt) & "$" & "A5:I262"
Debug.Print colWorksheets(lngCnt) & "$A5:I262"
        Next lngCnt
 
    Set colWorksheets = Nothing ' Delete the collection
 
End Sub

[Thompyt]

All, Thank you. Although its crude and a better way to do it. I have the code doing what I want it to do. With the exception of killing the excel that stays open hidden in the background. Killing it manually in task Manager at the moment.

Private Sub OpenExcel_Click()Dim varItem As Variant, lngCnt As Long
Dim ObjXL As Object, ObjWk  As Object, f As Object
Dim colWSht As Collection, WkBk As Workbook, WkSht As Worksheet
Dim blnHasFieldNames As Boolean, blnXL As Boolean, blnReadOnly As Boolean
Dim strFile As String, strFile2 As String, strFolder As String, strPathFile As String, strPathFile2 As String, strTable As String


' Establish an EXCEL application object
On Error Resume Next
    Set ObjXL = GetObject(strPathFile, "Excel.Application")
        If Err.Number <> 0 Then
    Set ObjXL = CreateObject("Excel.Application")
          blnXLL = True
        End If
Err.Clear
On Error GoTo 0


' True if the first row in EXCEL worksheet has field names
    blnHasFieldNames = True


' Opens Selection Box to select file
Set f = Application.FileDialog(1)
       f.AllowMultiSelect = False
    If f.Show Then
        For Each varItem In f.SelectedItems
            strFile = Dir(varItem)
            strFolder = Left(varItem, Len(varItem) - Len(strFile))
        Next
    End If


    If strFile = "" Then
        MsgBox "User pressed CANCEL"
           Exit Sub
    End If


    strTable = Left(strFile, InStr(strFile, ".") - 1)  '  Table name without the .xlsx  into which the data are to be imported
    strPathFile = strFolder & strFile
    strFile2 = "X_" & strFile
    blnReadOnly = False ' open EXCEL file in write mode


' Open the EXCEL file and read the worksheet names into a collection
Set colWSht = New Collection
Set WkBk = ObjXL.Workbooks.Open(strPathFile, , blnReadOnly)
Set ObjWk = ObjXL.Workbooks.Open(strPathFile, , blnReadOnly)
    For lngCnt = 1 To ObjWk.Worksheets.Count
        colWSht.Add ObjWk.Worksheets(lngCnt).Name
                Set WSht = ObjWk.Worksheets(lngCnt)
                With WSht
                    .Columns(8).Delete
                    .Columns(7).Delete
                    .Columns(6).Delete
                    .Columns(2).Delete
                    .Range("F1:Z1").EntireColumn.Delete
                    .Range("A1").EntireColumn.Insert
                    .Range("A1:A4").EntireRow.Delete
                        .Cells(1, 1) = "SystemOwner"
                        .Cells(1, 2) = "IPAddress"
                        .Cells(1, 3) = "URN"
                        .Cells(1, 4) = "RoleName"
                        .Cells(1, 5) = "SystemType"
                        .Cells(1, 6) = "Notes"
                        .Range("A2:A256").Cells.Value = WSht.Name
                 End With
        Next lngCnt
        
    WkBk.SaveAs strFolder & strFile2
    strPathFile2 = strFolder & strFile2


Set ObjWk = ObjXL.Workbooks.Open(strPathFile2, , blnReadOnly)
        
' Import the data from each worksheet into the table
    For lngCnt = 5 To colWSht.Count
        DoCmd.TransferSpreadsheet 0, 10, strTable, strPathFile2, blnHasFieldNames, colWSht(lngCnt) & "$A1:I262"
Debug.Print colWSht(lngCnt) & "  " & lngCnt
    Next lngCnt


'Close the EXCEL file without saving the file, and clean up the EXCEL objects
    Set ObjWk = Nothing
    Set ObjXL = Nothing
    Set colWSht = Nothing ' Delete the collection
    Set WkBk = Nothing
    Set WSht = Nothing
    Excel.Application.Quit
       Kill strFile2
    If blnXL = True Then ObjXL.Quit


End Sub

[Welshgasman]

Do you have Option Explicit in there anywhere?

I ask as You have Excel.Application.Quit ?

Would that not be objXl.Application.Quit

Also blnXLL and WSht are not declared, so it looks like you do not.

Plus I cannot get blnXL to be set to true?

Walk through your code line by line and see what it actually does.

Strangely enough, it does not complain about Excel.Application.Quit?

[Thompyt]

Welshgasman Thanks, the details always get me. I am using Option Explicit at the top. Now I wonder why it worked.

[Welshgasman]

Welshgasman Thanks, the details always get me. I am using Option Explicit at the top. Now I wonder why it worked.

So would I.