Home>

I am trying to copy the data of a specific sheet name in Excel that is not open in VBA and paste it into another workbook.

Error message
Run-time error '1004'
Unable to access '.xls'. The file is corrupted, on a non-responsive server, or set to read-only.


(The Excel is not damaged, is on the desktop, and is not read-only)

Applicable source code
Dim Path As String
    Dim buf As String
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    Dim number As String
    Dim type (200) As String
    Dim grade (200) As String
    Dim width (200) As Integer
    Dim Height (200) As Integer
    Dim Length (200) As Integer
    Dim n As Integer
    Dim x As Integer
    Dim i As Integer
    Dim strDir As String
    Dim strFile As String
    Dim xls As New Excel.Application
    Dim wb As Workbook
    'Get path
    With Application.FileDialog (msoFileDialogFolderPicker)
        .Show
        Path = .SelectedItems (1)
    End With
    'Get file name
    buf = Dir (Path&"\ *. xls *")
    Number = fso.GetBaseName (Path)
    Debug.Print (s)
 Dim objCn As New ADODB.Connection
    Dim objRS As ADODB.Recordset
    Dim sSheet As String
    With objCn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Properties ("Extended Properties") = "Excel 8.0"
        .Open Path&"\"&buf
        Set objRS = .OpenSchema (ADODB.adSchemaTables)
    End With
    Do Until objRS.EOF
        sSheet = objRS.Fields ("TABLE_NAME")
        If sSheet = "'group-1 $'" Then
        GoTo Group 1
ElseIf sSheet = "'Group-2 $'" Then
        GoTo Group 2
        Else
        GoTo Next
        End If
Next:
        objRS.MoveNext
    Loop
Group 1:
    Application.ScreenUpdating = False
    strDir = Path&"\"&buf
    strFile = Dir (strDir)
    n = 200
    x = Cells (Rows.Count, 3) .End (xlUp) .Row + 1
    Set wb = xls.Workbooks.Open (strDir) ← Stop here
    For i = 7 To n Step 1
        Type (i) = wb.Worksheets ("Group-1"). Cells (i, 3)
        Grade (i) = wb.Worksheets ("Group-1"). Cells (i, 4)
        Width (i) = wb.Worksheets ("Group-1"). Cells (i, 5)
        Height (i) = wb.Worksheets ("Group-1"). Cells (i, 6)
        Length (i) = wb.Worksheets ("Group-1"). Cells (i, 14)
    Cells (x, 2) = number
    Cells (x, 3) = Type (i)
    Cells (x, 4) = Grade (i)
    Cells (x, 5) = width (i)
    Cells (x, 6) = height (i)
    Cells (x, 7) = length (i)
    x = x + 1
    End If
    Next i
    Set xls = Nothing
    Application.ScreenUpdating = True
Group 2:
...
Tried

I searched online for a few days, but I don't understand the cause.
I am a VBA beginner and lack of knowledge, but I would like to ask you to use it to improve my work. Thank you.

Supplemental information (FW/tool version etc.)

Excel 2007
Windows 7

vba