このエラーの多くの問題が過去に尋ねられ、回答されていることは知っていますが、このケースはわずかしか見当たりません。問題の原因となります。珍しい - vbaエラー:オブジェクト変数またはブロック変数が設定されていない
excelファイルを検索してキーワードを検索し、そのキーワードが見つかった場所に関する情報を返すコードを作成しました。私が入力するほとんどのキーワードでコードは正常に動作しますが、マクロを実行すると91エラーメッセージが生成されることがあります。誰かがそれがすばらしい理由を理解できる場合!
コードは次のとおりです。
Sub SearchFolders()
Dim fso As Object
Dim fld As Object
Dim strSearch As String ' Keyword to search for
Dim strPath As String ' Filepath of folder to search
Dim strFile As String ' current file that the loop is searching through
Dim wOut As Worksheet ' Worksheet to display results
Dim wbk As Workbook ' Workbook to be searched
Dim wks As Worksheet ' Worksheet to be searched
Dim lRow As Integer
Dim rFound As Range
Dim strFirstAddress As String
Application.ScreenUpdating = False
'Change as desired
strPath = "\\ant\dept-eu\LTN1\Techies Information\aa Eng daily log"
strSearch = InputBox("Insert Keyword to search")
Set wOut = Sheet1
lRow = 1
With wOut
Sheet1.Cells.Clear
.Cells(lRow, 1) = "Workbook"
.Cells(lRow, 2) = "Worksheet"
.Cells(lRow, 3) = "Text in Cell"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strPath)
strFile = Dir(strPath & "\*.xls*")
Do While strFile <> ""
Set wbk = Workbooks.Open _
(Filename:=strPath & "\" & strFile, _
UpdateLinks:=0, _
ReadOnly:=True, _
AddToMRU:=False)
For Each wks In wbk.Worksheets ' for each worksheet
Set rFound = wks.UsedRange.Find(strSearch) ' setting variable to first result in find function
If Not rFound Is Nothing Then ' if something is found
strFirstAddress = rFound.Address ' set first address to that cell's address
End If
Do
If rFound Is Nothing Then ' if nothing was found
Exit Do ' exit loop
Else ' if something was found then add the details to the table
lRow = lRow + 1
.Cells(lRow, 1) = wbk.Name
.Cells(lRow, 2) = wks.Name
.Cells(lRow, 3) = rFound.Value
End If
Set rFound = wks.Cells.FindNext(After:=rFound) ' sets rfound vaiable to next found value
Loop While strFirstAddress <> rFound.Address ' once the find function gets back to the first address then exit the loop
Next ' next worksheet in file
wbk.Close (False)
strFile = Dir
Loop
.Columns("A:D").EntireColumn.AutoFit
End With
MsgBox "Done"
ExitHandler:
Set wOut = Nothing
Set wks = Nothing
Set wbk = Nothing
Set fld = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
Exit Sub
エラーがstrFirstAddress < Whileループで発生> rFound.Addressライン
このエラーは、 'rFound'が' strSearch'を見つけられなかったためにNothingに設定されていることを意味します。エラーチェックの配置を変更する必要があります。 – tigeravatar
ありがとう!私は今、If rFoundがNothingであり、exit do文を追加しました。そして今は正常に動作しているようです。 –