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

前提・実現したいこと

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

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

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

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

該当のソースコード

VBA
1Dim Path As String
2    Dim buf As String
3    Dim fso As FileSystemObject     
4    Set fso = New FileSystemObject
5    
6    Dim 番号 As String
7    Dim 種類(200) As String 
8    Dim 等級(200) As String 
9    Dim 幅(200) As Integer 
10    Dim 高さ(200) As Integer 
11    Dim 長さ(200) As Integer 
12    
13    Dim n As Integer
14    Dim x As Integer
15    Dim i As Integer
16        
17    Dim strDir As String
18    Dim strFile As String
19    Dim xls As New Excel.Application
20    Dim wb As Workbook
21    
22    'パス取得
23    With Application.FileDialog(msoFileDialogFolderPicker)
24        .Show
25        Path = .SelectedItems(1)
26    End With
27    
28    'ファイル名取得
29    buf = Dir(Path & "*.xls*")
30    番号 = fso.GetBaseName(Path)
31    Debug.Print (s)
32    
33 　 Dim objCn As New ADODB.Connection
34    Dim objRS As ADODB.Recordset
35    Dim sSheet As String
36        
37    With objCn
38        .Provider = "Microsoft.Jet.OLEDB.4.0"
39        .Properties("Extended Properties") = "Excel 8.0"
40        .Open Path & "\" & buf
41        Set objRS = .OpenSchema(ADODB.adSchemaTables)
42    End With
43 
44    Do Until objRS.EOF
45        sSheet = objRS.Fields("TABLE_NAME")
46        If sSheet = "'グループ-1$'" Then
47        GoTo グループ1
48　　　　 ElseIf sSheet = "'グループ-2$'" Then
49        GoTo グループ2
50        Else
51        GoTo 次
52        End If
53次:
54        objRS.MoveNext
55    Loop
56          
57グループ1:
58    Application.ScreenUpdating = False
59    strDir = Path & "\" & buf
60    strFile = Dir(strDir)
61    
62    n = 200         
63    x = Cells(Rows.Count, 3).End(xlUp).Row + 1
64    Set wb = xls.Workbooks.Open(strDir)←ここで止まります
65    For i = 7 To n Step 1
66        種類(i) = wb.Worksheets("グループ-1").Cells(i, 3)
67        等級(i) = wb.Worksheets("グループ-1").Cells(i, 4)
68        幅(i) = wb.Worksheets("グループ-1").Cells(i, 5)
69        高さ(i) = wb.Worksheets("グループ-1").Cells(i, 6)
70        長さ(i) = wb.Worksheets("グループ-1").Cells(i, 14)
71   
72    Cells(x, 2) = 番号
73    Cells(x, 3) = 種類(i)
74    Cells(x, 4) = 等級(i)
75    Cells(x, 5) = 幅(i)
76    Cells(x, 6) = 高さ(i)
77    Cells(x, 7) = 長さ(i)
78
79    x = x + 1
80
81    End If
82    Next i
83        
84    Set xls = Nothing
85    Application.ScreenUpdating = True
86
87グループ2:
88・・・
89
90

試したこと

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

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

Excel 2007
Windows 7

m.ts10806

2018/08/22 02:54

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

m.ts10806

2018/08/22 02:54

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

pokky1111

2018/08/22 04:18

ご指摘頂きありがとうございます。編集致しましたが、いかがでしょうか。

ExcelVBAer

2018/08/22 04:28

デバッグはされたのでしょうか？プロパティウィンドウ、イミディエイトウィンドウ、ステップ実行等を試して確認されたのでしょうか？

pokky1111

2018/08/22 06:50

デバックはしています。ローカルウィンドウを見ながら確認を行いましたがエラーが修正できませんでした。

行動規範の内容に同意します

回答1件

ベストアンサー

ADOでxlsファイルを開いたままExcel.Applicationでそのファイルを開こうとしているからでしょう。
シートを順に処理したいならわざわざADOを使わずともFor Each Item In Workbook.Worksheetsなどで回すといいのでは。

投稿2018/08/22 05:13

退会済みユーザー

総合スコア0

pokky1111

2018/08/22 07:27

ご回答いただきありがとうございます。以下のように書き換えたところ、「←」の位置でエラーが出てしまいました。（実行時エラー'9'　インデックスが有効範囲にありません。）（上略） 'ファイル名取得物件No = fso.GetBaseName(Path) Debug.Print (s) strDir = Path & "\" & buf For Each ws In Workbooks(strDir).Worksheets ←ここで止まります If ws.Name = "グループ-1" Then GoTo グループ1 ElseIf ws.Name = "グループ-2" Then GoTo グループ2 Else GoTo 次 End If 次: Next ws グループ1: Application.ScreenUpdating = False 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) ・・・（以下同じ）申し訳ありませんが、修正方法をご教授願います。

ExcelVBAer

2018/08/22 07:50

ブックを開かずに、どうやってシートにアクセスするのでしょうか？ Goto文をやたら使われてますが、他の言語の経験があるのでしょうか？

退会済みユーザー

2018/08/22 10:09

Workbooksコレクションは、**開いている** Workbookオブジェクトのコレクションですので、まずブックを開いてください。

退会済みユーザー

2018/08/22 10:53

あと、Workbooksのインデックスはフルパスではなくブック名で指定してください。でもWorkbooks.OpenでWorkbookオブジェクトが返ってきますので、インデックスを指定して取得する必要はないですね。

pokky1111

2018/08/23 02:06

ご回答頂きありがとうございます。ブックを開く必要があるのですね。他の言語の経験はございません。他の方法を知らないためGoto文を使っています。（上略） Workbooks.Open strDir For Each ws In Workbooks(buf).Worksheets （以下変更なし）と書き換えたところ、「非表示モジュール Module1内でコンパイルエラーが発生しました。」とエラーが出てしまいました。色々と調べてみたのですが、エラーをなくすことができませんでした。また、新規ブックに以下のマクロを組んでも同様のエラーが発生してしまいます。 Sub test() Workbooks.Open "フルパス" End Sub 度々申し訳ないのですが、修正方法をご存じでしたらご教授願います。

ExcelVBAer

2018/08/23 04:24

Goto文は仕事上では禁止されているものとなっています。理由としては、変数や処理の依存関係が複雑化し、いわゆるスパゲッティコードの主な原因となるからです。なので、処理を分けるなら、別関数化して呼び出すのが一般的です。該当箇所が不明なのにコンパイルエラーが出る場合、自分の経験では、参照設定を確認します。チェックしていた何かが「参照不可」となると、そういう状態になって１行もマクロが動かない場合があったと思います。

pokky1111

2018/08/23 07:56

ご回答頂きありがとうございます。確かにGoto文を使うと複雑になりますね。今後は別関数化して呼び出すようにします。ありがとうございます。参照設定について色々とチェックを外してみましたが、依然エラーが出ました。Workbooks.Openで開くブックを変更したところ問題なく開けたので、これまで開こうとしていたブックの設定に問題がありそうです。当該ブックはマクロ付きで、パスワードが設定されており、固有の参照設定が使われていそうです。このようなブックをWorkbooks.Openで開くことはできないのでしょうか。拙い説明で申し訳ありません。

退会済みユーザー

2018/08/24 09:16

非表示モジュール云々はそういった経験がないため私はお力になれません。といいますか、もう当初の質問とは別の問題なんじゃないでしょうか。

pokky1111

2018/08/28 06:09

コメントが遅くなり申し訳ありませんでした。別の問題のようですね。失礼しました。ExecuteExcel4Macroを使う方法を試したところ、なんとか解決しました。ご親切に回答頂いたExcelVBAer様、denchi様、ありがとうございました。

行動規範の内容に同意します