Dir and FileSearch

[samilynn]

It's now months later, and I am still baffled by the fact that FileSearch is gone from Excel 2007. I cannot get a grasp on the Dir Function, can anyone help me modify this code to use Dir instead of FileSearch?


Option Explicit

Dim rngData As Range

Sub ReadWorkbooks()

Const strDirectory As String = "C:\Documents and Settings\SamG\Desktop\mg"
Dim varFile As Variant

Set rngData = ThisWorkbook.Worksheets("Data").Range("A" & _
ThisWorkbook.Worksheets("Data").Range("A65536").End(xlUp).Row).Offset(1, 0)

Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = strDirectory
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For Each varFile In .FoundFiles
Merge varFile
Next
End If
End With
Application.ScreenUpdating = True

End Sub

Sub Merge(ByVal strFileName As String)

Dim lngEndRow As Long, lngRow As Long
Dim ws As Worksheet, shp As Shape

Workbooks.Open strFileName

For Each ws In ActiveWorkbook.Worksheets

ws.Rows(1).Insert
ws.Columns("M").Insert

lngEndRow = ws.Range("A65536").End(xlUp).Row
ws.Range("M2:M" & lngEndRow).FormulaR1C1 = "=CountA(RC1:RC[-1])"
ws.Range("A1:M" & lngEndRow).AutoFilter Field:=13, Criteria1:="<>0"

ws.Range("A2:L" & lngEndRow).SpecialCells(xlCellTypeVisible).Copy
rngData.Paste

For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp

Set rngData = ThisWorkbook.Worksheets("Data").Range("A" & _
ThisWorkbook.Worksheets("Data").Range("A65536").End(xlUp).Row).Offset(1, 0)
Next ws
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True

End Sub

 

[jindon]

try

Option Explicit
 
Dim rngData As Range
 
Sub ReadWorkbooks()
     
    Const strDirectory As String = "C:\Documents and Settings\SamG\Desktop\mg"
    Dim varFile As Variant
     
    Application.ScreenUpdating = False
    varFile = Dir(strDirectory & "\*.xls")
    Do While varFile <> ""
         Set rngData = _
            ThisWorkbook.Sheets("Data").Range("a" & Rows.Count).End(xlUp).Offset(1)
         Merge strDirectory & "\" & varFile
         varFile = Dir()
    Loop
    Application.ScreenUpdating = True  
End Sub

 

[samilynn]

Jindon,
I am now getting this error, as the first spreadsheet in the folder opens:

Run-time error '438'
Object doesn't support this property or method

Any thoughts?

 

[jindon]

I think it is from Merge sub...

Sub Merge(ByVal strFileName As String)
     
    Dim lngEndRow As Long, lngRow As Long
    Dim ws As Worksheet, shp As Shape
     
    With Workbooks.Open(strFileName)
         For Each ws In .Worksheets       
             ws.Rows(1).Insert
             ws.Columns("M").Insert
         
             lngEndRow = ws.Range("A65536").End(xlUp).Row
             If ws.FilterMode Then ws.FilterMode = False
             ws.Range("M2:M" & lngEndRow).FormulaR1C1 = "=CountA(RC1:RC[-1])"
             ws.Range("A1:M" & lngEndRow).AutoFilter Field:=13, Criteria1:="<>0"
         
             ws.Range("A2:L" & lngEndRow).SpecialCells(xlCellTypeVisible).Copy
             rngData.Paste
         
             ws.Shapes.Delete
         Next ws
         .Close False
    End With
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True
            
End Sub

 

[samilynn]

I now get this error, while it highlights .FilterMode = in the code

Compile error:
Can't assign to read-only property

 

[Richard Schollar]

Hi

Change the line to:

If ws.FilterMode Then ws.Autofilter

 

[samilynn]

Hi Richard.
I did, but then get the error:

Compile error:
Invalid use of property

while it highlights AutoFilter

 

[Richard Schollar]

Sorry, wrong property - just replace the line with

ws.Autofiltermode = False

No need to test as it won't fail if filtering isn't applied.