実行時エラー9 インデックスが有効範囲にありません！

質問

プログラムを編集するところ、実行時エラー９：インデックスが有効範囲にありません」ができてた。調べたのですが、原因は分からない、皆さん、助けてください。
以下はあるフォルダーを選定して、セルの値と一致するファイルを探し出して、シートＡの中のデータを取り上げて、コピーしないです。けど、エラーが出てきた。皆さん。よろしくお願いします。
Sub test()
Dim forName, bookName As String
Dim x, y, l As Long
Const cnsDIR = "\*.xls"
Dim bFound As Boolean
Dim myBook, actBook As Workbook
Dim mySheet, actSheet As Worksheet
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
myPath = .SelectedItems(1)
End If
End With
forName = Dir(myPath, vbDirectory)
If Dir(myPath, vbDirectory) = "" Then
MsgBox "It's nothing!", vbExclamation
Exit Sub
End If
bFound = False
For x = 2 To 7 Step 1
bookName = Dir(myPath & cnsDIR, vbNormal)
Do While bookName <> ""
l = InStrRev(bookName, ".xls")

If Mid(bookName, l - 4, 4) = Format(Cells(4, x), "0000") Then
bFound = True
Exit Do 'hang/lie
Else

bookName = Dir()
End If
Loop
If bFound = False Then
Rtn = MsgBox("This is no found. Do you want to continue?", vbYesNo, "選択")
If Rtn = vbNo Then Exit For
End If
Windows(bookName).Activate
actSheet = ActiveWorkbook.Sheets
For Each actSheet In Worksheets
If ActiveSheet.Name = "A" Then
Application.Union(Range("C55:F55"), Range("H55:I55")).Copy
ThisWorkbook.Sheets(4).Range("B5").PasteSpecial Paste:=xlValues, Transpose:=True
End If
Next
Next x
End Sub

回答No.1

t-aka · ベストアンサー

ステップインにて動作すればわかると思います。

Windows(bookName).Activateで実行時エラーのようです。

bookName = Dir()にてファイル名を次々に取得していますが
全てのファイルを取得した後、bookName = Dir()を実行すると
bookNameには""が格納されます。

ブック名""なんてのはありえないので
実行時エラーが発生します。

で、もう少し見てみると
見つからなかった場合の処理も変な感じがします。
たぶん、最初に戻ってフォルダを再指定したいはずなのに
そうなっていませんね。もう少し考える必要があるようです。

補足

ご回答、ありがとうございます。
やっぱり勉強足りなくて。。。
もうちょっと詳しく話していただけないでしょうか。
よろしくお願いします。

回答No.3

Wendy02

こんばんは。

>本を参考しても、調べても正確になってくれないので、ここで問題を出したわけです。

もう、ここら辺は、本で調べるレベルではなくて、ひたすらコードを書く段階に入っているように思います。一週間、あれこれいじってもうまく通らない場合、「あれこれいじった」こと自体が実力を上げているものだと思います。しかし、うまく行かない場合は、新たに書き直しても、スタートラインは、かなりレベルが上がった段階からなので、意外にうまく行くことが多いような気がします。

ご質問のコードから、私がどれほど読みきれているのか、という評価にもなりますが、私の書いたものも見ていただけますか？

一応、表示は、日本語をそのまま英語にしました。だから、少し、語順がヘンですが、それは、余興の範囲だとしてください。

'-------------------------------------------

'Option Explicit

Sub OpenFileProgram1()
　　Dim myFolder As String
　　Dim objFolder As Object
　　Dim fn As String
　　Dim rngData As Range
　　Dim myDir As Variant
　　Dim orgDir As Variant
　　Dim msgRet As VbMsgBoxResult
　　Dim temp As String
　　Dim x As Long, n As Variant
　　Const sEXT As String = "*.xls"
　　'フォルダ記録
　　myDir = ThisWorkbook.Path
　　orgDir = myDir

　　Set rngData = ActiveSheet.Range("B4:G4")
　　If Application.Count(rngData) = 0 Then _
　　　MsgBox "fileData on Activesheet, not found", vbExclamation: Exit Sub

　　Do
　　　　Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, _
　　　　"Choose Folder and Push Enter Key", 1, myDir)

　　　　If objFolder Is Nothing Then
　　　　　　Exit Sub
　　　　Else
　　　　　　myFolder = objFolder.Items.Item.Path
　　　　End If
　　　　If Dir(myFolder & "\" & sEXT) <> "" Then
　　　　　　For x = 1 To 6 ' start only from '1'
　　　　　　　　n = rngData(, x).Value 'Checkpoint
　　　　　　　　If n <> "" Then
　　　　　　　　　　fn = Dir(myFolder & "\" & n & Mid(sEXT, 2), vbNormal)
　　　　　　　　End If
　　　　　　　　If fn <> "" Then
　　　　　　　　　　msgRet = MsgBox(fn & " is OK?", vbQuestion + vbYesNoCancel) '
　　　　　　　　　　If msgRet = vbYes Then
　　　　　　　　　　　　Exit Do
　　　　　　　　　　'geting out
　　　　　　　　　　ElseIf msgRet = vbCancel Then
　　　　　　　　　　　　Exit Sub
　　　　　　　　　　'canceling
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　　　If fn = "" Then
　　　　　　temp = Mid(myFolder, InStrRev(myFolder, "\") + 1)
　　　　　　If MsgBox(temp & ":Target File No found" & _
　　　　　　　 vbCrLf & "Coutinue?", vbInformation + vbOKCancel) = vbCancel Then
　　　　　　End If
　　　　End If
　　Loop
　　On Error Resume Next
　　With Workbooks.Open(myFolder & "\" & fn)
　　　.Worksheets("A").Range("C55:F55", "H55:I55").Copy
　　　 ThisWorkbook.Sheets(4).Range("B5").Cells(1, x).PasteSpecial _
　　　　　　　　　Paste:=xlValues, Transpose:=True
　　　 ' Not better the usage of Sheets(4) but get the explicit name of worksheet in a 'Worksheets object'
　　　 .Close False
　　End With
　　If Err.Number > 0 Then
　　　 MsgBox Err.Number & " : " & Err.Description, vbExclamation
　　Else
　　　 MsgBox "Completed!", vbInformation
　　End If
　　On Error GoTo 0
　　ChDir orgDir
End Sub

補足

ご回答ありがとうございます。
親切に、詳しく書いていただいて、どうもありがとうございました。
コードをコピーして、実行したのですが、思うとおりになりませんでした。
でも、おっしゃったとおり、お書きになったコードを参考しながら、もう一度書き直したいです。
どうも、ありがとうございました。

回答No.2

Wendy02

こんにちは。

私の目からは、かなりコードの無駄が多すぎるような気がしますが、もし、ご自分で書いたものなら、この程度のエラーの原因は自力で解決してほしいなって思います。せっかくのコードが泣いてしまいます。こういうバグつぶしが、上達させますからね。

単に、Workbooks.Openがないだけですね。
たぶん、その引数は、myPath & "\" & bookName と間に「\」が入るとは思いますが。

もし、これが、ご自分が書いたコードで、ご希望があれば、こちらも試しに見本のコードを出しても良いと思いますが、もし、マクロの勉強中なら、今回のようなコードは悪くないです。盛りだくさんのメソッドは、めったに使わないものでも、一度や二度は使ってみなければ覚えないからです。

補足

ご回答ありがとうございます。
実はこの問題は、一週間前から出てきて、ずっとこれを解決しようとしたのですが、本を参考しても、調べても正確になってくれないので、ここで問題を出したわけです。
できれば、見本を参考させていただければ、自分の勉強には役に立つと考えておりますが、ご都合がよろしければ、よろしくお願いします。