Replacement for Application.FileSearch

StephL

New Member
Joined
Jun 10, 2011
Messages
4
Hi, I've been reading this forum for a while, but this is my first post. :)

I've created in macro in Excel 2003 that uses Application.FileSearch to open all Excel files in a specified directory. I've used a variable (vinputfile) to hold name of the open file and the macro then copies cells from vinputfile, activates a master sheet (from which the macro is run), and pastes the copied data into the mastersheet. The copy and paste process is then repeated switching between vinput file and the mastersheet until all the relevant information has been copied into the mastersheet, at which point the 'vinputfile' is closed. the macro then repeats the process for each Excel file in turn, before finally formatting the master sheet.

Everything works fine in Excel 2003, but the macro also needs to run on Excel 2007. I realise that Application.FileSeach can't be used with 2007 so I've looked for alternatives online and although there are lots of examples, I'm a novice with VBA I can't seem to get any of them to work with my code!

My current working Excel 2003 macro is below (i've cut out most out the copy and paste part as it just repeats itself with different cell reference).

Code:
Sub Copy_Forms_To_Master()
'-----------------------------------------------------------------
'
' Copy_Forms_To_Master Macro
'
' Keyboard Shortcut: Ctrl+r
'
' Macro will look for Excel files in a specified directory.
' The contents of the spreadsheet will be copied and pasted into
' the master sheet (which contains the macro).
'
'-----------------------------------------------------------------
  Dim i As Integer
  Dim vinputfile As String 'Use variable to hold filename
 
  'return to first blank row from bottom of sheet to ensure that any  'existing data is not overwritten.
   Range("A65536").End(xlUp).Offset(1).Select
 
   'Do not display page breaks as this slows performance of the macro
   ActiveSheet.DisplayPageBreaks = False
 
'Open all workbooks in specified folder.
  With Application.FileSearch
'Specify directory for input spreadsheets
    .LookIn = "G:\My Documents\Excel\Processing"
'Only look for Excel files
    .FileType = msoFileTypeExcelWorkbooks
'Excel workbook(s) have been found
     If .Execute > 0 Then
        For i = 1 To .FoundFiles.Count
'Stop screen flicker of workbooks being opened
Application.ScreenUpdating = False 
          Workbooks.Open (.FoundFiles(i))
          v = Split(.FoundFiles(i), "\") 
          fname = v(UBound(v))
          vinputfile = fname
'----------------------------------------------------
'Copy from input form(s) and paste into  master sheet
'----------------------------------------------------
    Range("C12:I12").Select
    Selection.Copy
    Windows("Master.xls").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    ActiveCell.Offset(0, 1).Select
 
'most of copy and paste edited out
 
    Windows(vinputfile).Activate
    Range("C199:I199").Select
    Selection.Copy
    Windows("Master.xls").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    ActiveCell.Offset(0, 1).Select
    ActiveWorkbook.Save 'SL: Save the data copied to the master sheet
'*******************************
    Windows(vinputfile).Activate
 
'Prevent'Do you want to save changes' message being displayed
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
 
'Reset Application.DisplayAlert property
    Application.DisplayAlerts = True
 
'Clear out filename variable
    vinputfile = ""
 
'---------------------------------------------------------
'Loop through macro with next file in specified directory
        Next i
      'There are no wb's
      Else
'Display message if there are no Excel files in directory
        MsgBox "There are no workbooks to open", vbOKOnly
      End If
  End With
 
'---------------------------------------------------------
'Resize worksheet columns and remove borders in master sheet
 
    Columns("A:CQ").Select
    Columns("A:CQ").EntireColumn.AutoFit
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveWorkbook.Save
 
End Sub

Any help would be greatly appreciated as I've been battling with this for about a week now and I just seem to be going round in circles. :(

Many thanks,
Steph
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Hi,

I've managed to solve the problem I was having by using Dir to replace Application.FileSearch. I've tested the macro and it now works fine in both Excel 2003 & 2007 :)

I though I'd post my new code just in case it can help anyone else having similar problems...

Code:
Sub Copy_Forms_To_Master()
'-----------------------------------------------------------------
'
' Copy_Forms_To_Master Macro
'
' Keyboard Shortcut: Ctrl+r
'
' Macro will look for Excel files in a specified directory.
' The contents of the spreadsheet will be copied and pasted into
' the master sheet (which contains the macro).
'
'-----------------------------------------------------------------
 'return to first blank row from bottom of sheet to ensure that any existing data is not overwritten.
   Range("A65536").End(xlUp).Offset(1).Select
 
 'Do not display page breaks as this slows performance of the macro
   ActiveSheet.DisplayPageBreaks = False
 
'Declare variables
Dim vinputfile As String 'Use variable to hold filename
Dim oWbk As Workbook
Dim sFil As String
Dim sPath As String
 
' *** Application.FileSeach replaced as not compatible with Excel 2007 ***
'Specify the path of the files to be opened
sPath = "G:\My Documents\Excel\Processing CSCS1\CSCS1 Voluntary Exit Terms\Input" 
ChDir sPath
'Specify thy type of file to be opened
sFil = Dir("*.xls") 'change or add formats
'will start LOOP until all files in folder sPath have been looped through
Do While sFil <> ""
'Opens the file
Set oWbk = Workbooks.Open(sPath & "\" & sFil) 
 
'****************************************************************************
' Stop screen flicker of workbooks being opened
Application.ScreenUpdating = False 
'Populate filename variable    
  vinputfile = sFil
'----------------------------------------------------
'Copy from input form(s) and paste into  master sheet
'----------------------------------------------------
    Range("C12:I12").Select
    Selection.Copy
    Windows("Master.xls").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    ActiveCell.Offset(0, 1).Select
 
'most of copy and paste edited out
 
    Windows(vinputfile).Activate
    Range("C199:I199").Select
    Selection.Copy
    Windows("Master.xls").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    ActiveCell.Offset(0, 1).Select
    ActiveWorkbook.Save 'SL: Save the data copied to the master sheet
'*******************************
    Windows(vinputfile).Activate
 
oWbk.Close False 'close the workbook without saving changes
'SL: 'return to first blank row from bottom of master sheet
    Range("A65536").End(xlUp).Offset(1).Select
 
'SL: Clear out filename variable
    vinputfile = ""
sFil = Dir
Loop ' End of LOOP
'---------------------------------------------------------
'SL: Resize worksheet columns and remove borders in master sheet
 
    Columns("A:CQ").Select
    Columns("A:CQ").EntireColumn.AutoFit
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'SL: Return to first blank row from bottom of master sheet
    Range("A65536").End(xlUp).Offset(1).Select
'SL:Prevent Excel Compatibility Checker' message being displayed
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
 
'SL:Reset Application.DisplayAlert property
    Application.DisplayAlerts = True
End Sub

Steph
 
Upvote 0
Thanks Steph.

FYI, you do not have to Select. For instance, at the end of the code, this is useless:

Columns("G:J").Borders.LineStyle = xlNone

Code:
Columns("A:CQ").Select
    Columns("A:CQ").EntireColumn.AutoFit
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Replace it with:

Code:
With Columns("A:CQ")
    .AutoFit
    .Borders.LineStyle = xlNone
End With

Less code, and less hard-coded elements in the code.

Wigi
 
Upvote 0
Hi Wigi,

Thanks for the tip!

Most of the macro was created using the macro recorder (hence all the selections), so I'll try replacing it with the code you've suggested. :)

Thanks again,

Steph
 
Upvote 0
Most of the macro was created using the macro recorder

Nooo, is it??? I would never have thought it was!

:) Just kidding of course.

If you need further help, please ask again.

Wigi
 
Upvote 0
I know - who'd have thought! ;)

I've got rid of all the selections and tried the code you suggested.

The macro's running much more smoothly now so thanks again for all your help Wigi - you're a star! :biggrin:
 
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,338
Members
448,569
Latest member
Honeymonster123

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top