File search function for excel 2010

[vba317]

I have a macro written for excel 2003. My File search function no longer works. I have tried to change my file search function with no luck. I am hoping that someone could help me, I would appreciate it.

I am currently getting a compile error

My current code is:

Sub Allfilesupdate()


I am getting a complie error with the following code:
Highlighted in Red is where I am getting my compile error

Function CreateFileList(FileFilter As String_
IncludeSubFolder As Boolean) As Variant

I have attached my macro in a file

 

[combo]

There is no FileSearch in office object model since 2007. See tips in thread707-1451668.

combo

 

[SkipVought]

Also, we are NOT going to 'see' your C Drive!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vba317]

I tried the recommended code. I don't get any errors but the macro is not working correcctly.

I have a file that I open with a button in it this button has the macro to open files in another directory and do some calculations.

What is happening is the files are not getting opened. but the calclations are being done in the spreadsheet that has the button in it.

Any help is appreciated. BTW I can't seem to be able to attach files, any help would be appreciated.

 

[vba317]

My current code (Which is shortened) is as follows:

 Sub Allfilesupdate()
    Dim ws As Worksheet
    Dim lCount As Long
    Dim wbResults As Workbook
    Dim wbCodeBook As Workbook
    Dim CL1 As Long
    Dim SR1 As Long
    Dim SR2 As String
    Dim SR3 As Long
    Dim R1 As Double
    'Second Loop
    Dim R2 As Double
    

 Dim LowM1 As Double
     Dim LowM2 As Double
    Dim LowP1 As Double    
    Dim LowP2 As Double   
    Dim HighM1 As Double
    Dim HighM2 As Double
    Dim HighP1 As Double
    Dim HighP2 As Double

 Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    On Error Resume Next
    
       Set wbCodeBook = ThisWorkbook

    With Application.FileSearch
        .NewSearch
       
        .LookIn = "C:\Data\Daily_A"
        
        .FileType = msoFileTypeExcelWorkbooks
        .Filename = "ETF*.xls"

        If .Execute > 0 Then 'Workbooks in folder

            For lCount = 1 To .FoundFiles.Count 'Loop through all files.
                'Open Workbook x and Set a Workbook variable to it
                Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                
               
                Call BulkQuotesXL.UpdateData
               
                For Each ws In Worksheets

                    With ws
                        .Activate
                        Range("A3").Select
                        'Calculate Last Row
                        LR = ActiveSheet.UsedRange.Rows.Count
                        'Clear cells
                        
                       
                        Select Case .Name

                            Case "BulkQuotesXL Settings"

                            Case Else
                                'Freeze Panes
                                Rows("2:2").Select
                                ActiveWindow.FreezePanes = True

                                Range("I1").Value = "Fib1 Value"
                                Range("J1").Value = "Fib2 Value"
                                Range("K1").Value = "Fib3 Value"
                                Range("L1").Value = "Fib4 Value"
                                Range("M1").Value = "Fib5 Value"
                                
                                
                                For R1 = 4 To LR
                                
                                    ' Min Value Calculation
                                    
                                     'A leg Low location
                                    LowM2 = (Range("D" & R1) - Range("D" & R1 - 2))
                                    LowM1 = (Range("D" & R1) - Range("D" & R1 - 1))
                                    LowP1 = Range("D" & R1 + 1) - Range("D" & R1)
                                    LowP2 = Range("D" & R1 + 2) - Range("D" & R1)
                                    ' Max Value Calculation
                                    'B leg High location
                                    HighM2 = (Range("C" & R1) - Range("C" & R1 - 2))
                                    HighM1 = (Range("C" & R1) - Range("C" & R1 - 1))
                                    HighP1 = Range("C" & R1 + 1) - Range("C" & R1)
                                    HighP2 = Range("C" & R1 + 2) - Range("C" & R1)
                                    
                                                                      
                                    'A leg Low header
                                    Range("H1").Value = "Low"
                                    
                                    If LowM2 < -0.15 And LowM1 < 0.08 And LowP1 > 0.05 And LowP2 > -0.1 Then Range("H" & R1).Value = (Range("D" & R1))
                                    If LowM2 < -0.15 And LowM1 < 0.08 And LowP1 > 0.05 And LowP2 > -0.1 Then Range("D" & R1).Interior.Color = vbRed
                                                                        
                                    'B leg High header
                                    Range("G1").Value = "High"
                                    
                                    If HighM2 >= -0.2 And HighM1 >= -0.05 And HighP1 < -0.2 And HighP2 < -0.05 Then Range("G" & R1).Value = (Range("C" & R1))
                                    If HighM2 >= -0.2 And HighM1 >= -0.05 And HighP1 < -0.2 And HighP2 < -0.05 Then Range("C" & R1).Interior.Color = vbGreen
                                                                                                    
                                   
                                Next R1

                            End With

                               
                      
                     End Select

                    End With

                Next
                
                LR1 = LR - 1
               
              
              End If
        
         Next lCount
        
        End If
        
    End With

    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
  
End Sub

The macro is not opening files in the C:\Data\Daily_A directory instead it is doing the calculations in the excel file that has the button in it that is linked to the macro. Any help would be appreciated.

 

[PHV]

For Each ws In [!]wbResults.[/!]Worksheets

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[vba317]

PHV,
I tried your solution with no luck.
I stepped through my macco and found when get to the With Application.FileSearch part and hover the mouse over it I see the message <Object does not support this action> So I took File search out and the period. I noticed when I stepped through the properties that .Filesearch is not included. Is there a reference that I need to add?

Tom

 

[strongm]

1.

>I noticed when I stepped through the properties that .Filesearch is not included.

As combo said earlier, FileSearch no longer exists in Office 2007 and later


2.

>On Error Resume Next

The above line is concealing a HUGE number of problems from you.

 

[PHV]

Well, the "official" answer is here:

http://support.microsoft.com/kb/920229

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[PHV]

Anyway, have a look here:

http://dfenton.com/DFA/download/Access/FileSearch.html

http://www.freevbcode.com/ShowCode.asp?ID=2318

http://www.bettersolutions.com/vba/VEV233/SA516613332.htm

...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886