VBA - 特定のブックとは別に、ディレクトリ内のすべてのブックを検索しますか？

Question

私は、ディレクトリ内のすべてのブックを検索するには、次のコードを使用しています：

Option Explicit 

Sub Search() 

Dim myFolder As Folder 
Dim fso As FileSystemObject 
Dim destPath As String 
Dim myClient As String 

myClient = ThisWorkbook.ActiveSheet.Range("J10").Value 

If myClient = "" Then Exit Sub 

Set fso = New FileSystemObject 

destPath = "G:\WH DISPO\(3) PROMOTIONS\(18) Food Specials Delivery Tracking\Archive\" 

Set myFolder = fso.GetFolder(destPath) 



'Set extension as you would like 
Call RecurseSubfolders(myFolder, ".xlsm", myClient) 

End Sub 


Sub RecurseSubfolders(ByRef FolderToSearch As Folder, _ 
      ByVal fileExtension As String, ByVal myClient As String) 


Dim app As New Excel.Application 
app.Visible = False 'Visible is False by default, so this isn't necessary 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.EnableEvents = False 

Dim fileCount As Integer, folderCount As Integer 
Dim objFile As File 
Dim objSubfolder As Folder 

fileCount = FolderToSearch.Files.Count 
'Loop over all files in the folder, and check the file extension 
If fileCount > 0 Then 
    For Each objFile In FolderToSearch.Files 
    If LCase(Right(objFile.Path, Len(fileExtension))) = LCase(fileExtension) And objFile.Path Like "temp" Then 
     'You can check against "objFile.Type" instead of the extension string, 
     'but you would need to check what the file type to seach for is 
     Call LookForClient(objFile.Path, myClient) 
    End If 
    Next objFile 
End If 

folderCount = FolderToSearch.SubFolders.Count 
'Loop over all subfolders within the folder, and recursively call this sub 
If folderCount > 0 Then 
    For Each objSubfolder In FolderToSearch.SubFolders 
    Call RecurseSubfolders(objSubfolder, fileExtension, myClient) 
    Next objSubfolder 
End If 

End Sub 


Sub LookForClient(ByVal sFilePath As String, ByVal myClient As String) 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.EnableEvents = False 

Dim wbTarget As Workbook 
Dim ws As Worksheet 
Dim rngFound As Range 
Dim firstAddress As String 
Static i As Long   'Static ensures it remembers the value over subsequent calls 

'Set to whatever value you want 
If i <= 0 Then i = 20 

Set wbTarget = Workbooks.Open(fileName:=sFilePath) 'Set any other workbook opening variables as appropriate 
'On Error Resume Next 
'Loop over all worksheets in the target workbook looking for myClient 
For Each ws In wbTarget.Worksheets 


    With ws.Range("A:Q") 
    Set rngFound = .Find(What:=myClient, LookIn:=xlValues, LookAt:=xlPart) 

    If Not rngFound Is Nothing Then 
     firstAddress = rngFound.Address 

     'Loop finds all instances of myClient in the range A:Q 
     Do 
     'Reference the appropriate output worksheet fully, don't use ActiveWorksheet 
     ThisWorkbook.ActiveSheet.Range("E" & i).Value = rngFound.Value 
     ThisWorkbook.ActiveSheet.Range("J" & i).Value = rngFound.Address 
     ThisWorkbook.ActiveSheet.Range("L" & i).Value = rngFound.Parent.Parent.Name 

     With ThisWorkbook.Worksheets(1) 
     .Hyperlinks.Add Anchor:=.Range("P" & i), _ 
     Address:=Application.Workbooks(rngFound.Parent.Parent.Name).Path & "\" & rngFound.Parent.Parent.Name, _ 
     ScreenTip:="Open Workbook", _ 
     TextToDisplay:=Application.Workbooks(rngFound.Parent.Parent.Name).Path & "\" & rngFound.Parent.Parent.Name 
     End With 

     ThisWorkbook.ActiveSheet.Range("Y" & i).Value = "Go to Cell" 
     ThisWorkbook.ActiveSheet.Range("Y" & i).Font.Underline = True 



     i = i + 1 
     Set rngFound = .FindNext(After:=rngFound) 
     Loop While (Not rngFound Is Nothing And rngFound.Address <> firstAddress) 
    End If 
    End With 

Next ws 

'Close the workbook 
wbTarget.Close SaveChanges:=False 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Application.EnableEvents = True 
End Sub 

は、私は1つのワークブック「temp.xlsm」を除外したいです。

私はこれしようとしています：

If LCase(Right(objFile.Path, Len(fileExtension))) = LCase(fileExtension) And objFile <> "temp.xlsm" Then 

をしかし、これは動作するようには思えません。結果が得られず、コードでエラーが発生しません。

私が間違っている場所を誰かに見せてもらえますか？

Answer 1

この問題を解決するための良い方法は、次の操作を行うことです。

-makeすべて無視リストの配列。

- ws.Nameの値がこの配列に存在するかどうかを確認してください。それが存在しない場合は、アクションを実行します。

If not fnBlnValueInArray(ws.Name, arrayOfAllIgnoredLists,True) 
     'do your stuff 
end if 

文字列の配列を作成し、値がこの配列にあるかどうかをチェックするというアイデアは、ここで見ることができます：

Option Explicit 

Public Function fnBlnValueInArray(myValue As Variant, _ 
            myArray As Variant, _ 
            Optional blnIsString As Boolean = False, _ 
            Optional strSeparator As String = ":") As Boolean 

    Dim lngCounter As Long 

    If blnIsString Then 
     myArray = Split(myArray, strSeparator) 
    End If 

    For lngCounter = LBound(myArray) To UBound(myArray) 
     myArray(lngCounter) = CStr(myArray(lngCounter)) 
    Next lngCounter 

    fnBlnValueInArray = Not IsError(Application.Match(CStr(myValue), myArray, 0)) 

End Function 


Public Sub TestMe() 

    Dim myStrArray As String 
    Dim myArray  As Variant 
    Dim myValue1 As Variant 
    Dim myValue2 As Variant 
    Dim myValue3 As Variant 

    myValue1 = "the" 
    myValue2 = "lazyashell" 
    myValue3 = 42 

    myArray = Array("the", "quick", "brown", "fox", 32, 32, 33, 42) 
    myStrArray = "the:quick:brown:fox:334:33:42" 

    Debug.Print fnBlnValueInArray(myValue1, myArray, False) 
    Debug.Print fnBlnValueInArray(myValue2, myArray, False) 
    Debug.Print fnBlnValueInArray(myValue3, myArray, False) 

    Debug.Print fnBlnValueInArray(myValue1, myStrArray, True, ":") 
    Debug.Print fnBlnValueInArray(myValue2, myStrArray, True) 
    Debug.Print fnBlnValueInArray(myValue3, myStrArray, True) 

End Sub 

は、コードのTestMe一部を実行し、それが値かどうかを示すだろう配列内にあります。