VBA 実行時エラー'1004'　'.xls'にアクセスできません

前提・実現したいこと

VBAで開いていないExcelの特定のシート名のデータをコピーし、別のブックに貼り付けようとしています。

発生している問題・エラーメッセージ

VBA
実行時エラー'1004'
'.xls'にアクセスできません。ファイルが破損しているか、応答しないサーバーにあるか、読み取り専用に設定されています。

（当該Excelは破損しておらず、デスクトップ上にあり、読み取り専用でもありません）

該当のソースコード

VBA
Dim Path As String
    Dim buf As String
    Dim fso As FileSystemObject     
    Set fso = New FileSystemObject
    
    Dim 番号 As String
    Dim 種類(200) As String 
    Dim 等級(200) As String 
    Dim 幅(200) As Integer 
    Dim 高さ(200) As Integer 
    Dim 長さ(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
    
    'パス取得
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        Path = .SelectedItems(1)
    End With
    
    'ファイル名取得
    buf = Dir(Path & "*.xls*")
    番号 = 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 = "'グループ-1$'" Then
        GoTo グループ1
　　　　 ElseIf sSheet = "'グループ-2$'" Then
        GoTo グループ2
        Else
        GoTo 次
        End If
次:
        objRS.MoveNext
    Loop
          
グループ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)←ここで止まります
    For i = 7 To n Step 1
        種類(i) = wb.Worksheets("グループ-1").Cells(i, 3)
        等級(i) = wb.Worksheets("グループ-1").Cells(i, 4)
        幅(i) = wb.Worksheets("グループ-1").Cells(i, 5)
        高さ(i) = wb.Worksheets("グループ-1").Cells(i, 6)
        長さ(i) = wb.Worksheets("グループ-1").Cells(i, 14)
   
    Cells(x, 2) = 番号
    Cells(x, 3) = 種類(i)
    Cells(x, 4) = 等級(i)
    Cells(x, 5) = 幅(i)
    Cells(x, 6) = 高さ(i)
    Cells(x, 7) = 長さ(i)

    x = x + 1

    End If
    Next i
        
    Set xls = Nothing
    Application.ScreenUpdating = True

グループ2:
・・・

試したこと

ネット上で2,3日調べましたが原因がわかりません。
VBA初心者で知識不足ですが、業務改善のために使用したいためご教授頂きたいです。宜しくお願い致します。

補足情報（FW/ツールのバージョンなど）

Excel 2007
Windows 7

m.ts10806

2018/08/22 02:54

プログラムコード(およびエラーメッセージ)は質問内容としては最も重要な部分であるため、見やすくしていただけると助かります。<code>ボタン押下→「コード」部分にコードを貼り付け→「ここに言語を入力」に対象言語名記入（エラーメッセージの場合は不要）の手順で「コードハイライト化」してください。（質問編集画面ではリアルタイムでプレビューが表示されるので見ながら調整してください）

m.ts10806

2018/08/22 02:54

質問編集画面タイトル横にある「初心者アイコン」をご活用ください。「初心者」と質問で書くよりも伝わりますし、質問一覧に表示されるのでわかりやすくなります。