Recurisive ability

[SonuB7]

As this method has been deprecated after 2007 I have been looking for alternatives and the best and most simple one I came across is yours because I have only basic knowledge of VBA and yours allows simple modification.

Your YtoFileSarch.vba class module works well but for my use it is missing the recursive search ability. My code has "SearchSubFolders", "MatchTextExactly", "FileType". Without these features my program does not work well. ( When I delete these 3 then the code finished executing so I know everything works but I can't get the result I need unless these 3 items work with your class module)

If you could modify the clas module to work with these I would be very thankful.

[MonsieurV]

Hey @SonuB7

Glad this class (could) help!

I'm not sure I will be able to respond to your request. However in order to try, could you provide samples for the SearchSubFolders, MatchTextExactly and FileType properties?

(You can directly provides the code calling Application.FileSearch, anonymizing elements if needed)

The doc provides examples, but yours welcome.

Relevant doc entries:

• https://msdn.microsoft.com/en-us/library/office/aa211052(v=office.11).aspx
• https://msdn.microsoft.com/en-us/library/office/aa210763(v=office.11).aspx
• https://msdn.microsoft.com/en-us/library/office/aa210582(v=office.11).aspx

[SonuB7]

The code is below. Here is an example of where file (76993) would be located. Thanks for replying.

O:\Sukh's documents\Completed Orders 2018\Better Kitchens\76993 (18-03-21) 999, R-PM-SH-MF-0-0-0, BETTER KITCHEN INC (41pcs) MAIN KITCHEN (DUE 18-04-18).xls

' '
Dim fs As YtoFileSearch Set fs = New YtoFileSearch . .

   If InvoiceToSearch <> "" Then
         'With Application.FileSearch - (Sonu modification 2018/05/09)
         With fs
            .NewSearch
            .LookIn = "O:\Sukh's documents\"
            .SearchSubFolders = True
            .fileName = InvoiceToSearch & " *"
            .MatchTextExactly = True
            .FileType = msoFileTypeExcelWorkbooks
            If .Execute() > 0 Then '1 or >1 files found
                'even if more than 1 file found, their is only one invoice# to reference.  Thus info from Invoice Log can be taken right away and printed
                'the delivery date is retrieved from the above process and then the found files are each individually opened
                ProcessingSheet.Cells(i, FilesFoundCol) = .FoundFiles.Count
                Call SearchInvoiceLog(ProcessingSheet, SheetToSearch, InvoiceToSearch, i, DeliveryDate, EmptyDeliveryDate, DueDate, StationCol, StationDate)
                Select Case StationCol
                    Case 12: StationString = "OMGA"
                    Case 13: StationString = "PANEL"
                    Case 14: StationString = "ASSEMBLY"
                    Case 15: StationString = "CNC"
                    Case 16: StationString = "SANDING"
                    Case 17: StationString = "COMPLETE"
                    Case 18: StationString = "DELIVERED"
                    Case Else: StationString = "NOT STARTED"
                End Select
                For j = 1 To .FoundFiles.Count - 1
                    ProcessingSheet.Rows(i + 1).Insert Shift:=xlDown
                Next j
                'Whether .FoundFiles.Count is equal to or > 1
                For j = 1 To .FoundFiles.Count
                    SelectedFileFullName = .FoundFiles(j)
                    SelectedFileShortName = FileNameOnly(SelectedFileFullName): Application.AskToUpdateLinks = False
                    Workbooks.Open fileName:=SelectedFileFullName
                    Set Invoice = Workbooks(SelectedFileShortName).Worksheets("Invoice")
                    AmountValue = Invoice.Cells(Rows.Count, 8).End(xlUp).Value
                    ProcessingSheet.Cells(i, AmountCol) = AmountValue
                    If PrintPO = True Then
                        ProcessingSheet.Cells(i, PrintedCol) = "PRINTED (" & .FoundFiles.Count & ")"
                        Set POshop = Workbooks(SelectedFileShortName).Worksheets("POshop")
                        POshop.Select
                        With POshop
                            If ProcessingSheet.Cells(i, ManualDueCol) <> "" Then PrintedDueDate = ProcessingSheet.Cells(i, ManualDueCol) Else PrintedDueDate = DueDate
                            DueDateString = Format(DueDate, "mmm-dd")
                            PrintedDueDateString = Format(PrintedDueDate, "dddd, mmmm dd")
                            StationDateString = Format(StationDate, "dddd, mmmm dd")
                            LastRowPOshop = Cells(Rows.Count, 4).End(xlUp).Row
                            With Range(Cells(LastRowPOshop + 1, 1), Cells(LastRowPOshop + 10, 8))
                                .MergeCells = False
                            End With
                            With Range(Cells(LastRowPOshop + 1, 1), Cells(LastRowPOshop + 2, 8))
                                .HorizontalAlignment = xlCenter
                                .Font.Name = "Arial"
                                .Font.Size = 18
                                .MergeCells = True
                            End With
                            With Range(Cells(LastRowPOshop + 3, 1), Cells(LastRowPOshop + 3, 8))
                                .HorizontalAlignment = xlCenter
                                .Font.Name = "Arial"
                                .Font.Size = 12
                                .MergeCells = True
                            End With
                            Cells(LastRowPOshop + 1, 1) = "MUST DELIVER ON: " & PrintedDueDateString
                            If StationString <> "NOT STARTED" Then
                                Cells(LastRowPOshop + 3, 1) = "Last Recorded Station: " & StationString & " on " & StationDateString
                            Else
                                Cells(LastRowPOshop + 3, 1) = "Last Recorded Station: " & StationString
                            End If
                            If ProcessingSheet.Cells(i, ManualDueCol) <> "" And ProcessingSheet.Cells(i, ManualDueCol) <> DueDate Then
                                ActiveSheet.PageSetup.RightFooter = "dd: " & DueDateString
                            Else
                                ActiveSheet.PageSetup.RightFooter = "dd: a/a"
                            End If
                        End With
                        With POshop.PageSetup
                            .PrintArea = Range(POshop.Cells(1, 1), POshop.Cells(LastRowPOshop + 3, 12)).Address
                            .FitToPagesWide = 1
                            .FitToPagesTall = 1
                        End With
                        ActiveWindow.SelectedSheets.PrintOut Copies:=1
                    End If

                    Workbooks(SelectedFileShortName).Close SaveChanges:=False

                    i = i + 1
                Next j
            Else
                ProcessingSheet.Cells(i, FilesFoundCol) = 0
                ProcessingSheet.Cells(i, FilesFoundCol).Interior.ColorIndex = 3
                Call SearchInvoiceLog(ProcessingSheet, SheetToSearch, InvoiceToSearch, i, DeliveryDate, EmptyDeliveryDate, DueDate, StationCol, StationDate)
                'ProcessingSheet.Cells(i, PrintedCol) = "NOT PRINTED"
                'ProcessingSheet.Cells(i, PrintedCol).Interior.ColorIndex = 6
                i = i + 1
            End If
        End With
    Else
        i = i + 1
    End If
Loop Until InvoiceToSearch = LastInvoice