Application.FileSearch Error

[crex27]

Hi Guys,
I am not good with VBA.
Recently all are sytems are migrated from WIN XP to Win7.
Since then whenever we run a specific macro we get an error.
Can somebody help me fix the code..


PFB the code :

Option Explicit
Dim fd As FileDialog ' 'Declare a variable as a FileDialog object.
Dim varSelectedItem As Variant ' Path of folder
Dim wb As Workbook
Dim ws As Worksheet
Sub ImportData()

Dim i As Integer
Application.Calculation = xlCalculationManual
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
'Use a With...End With block to reference the FileDialog object.
With fd
'Use the Show method to display the File Picker dialog box
'The user pressed the action button.
If .Show = True Then
.Title = "Select a Folder"
.AllowMultiSelect = False
varSelectedItem = .SelectedItems(1)
Else
MsgBox "Cancelled", vbApplicationModal, "Select Folder"
End If
End With
'************************************
With Application.FileSearch
.NewSearch
.LookIn = varSelectedItem
.SearchSubFolders = False
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
'Open each workbook
Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
'Perform the operation on the open workbook
wb.Worksheets("sheet1").Cells.Select
Selection.Copy
ThisWorkbook.Sheets("Dump").Activate
ThisWorkbook.Sheets("Dump").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Call Macro14
'close the workbook
wb.Close
'On to the next workbook
Next i
End With
'**************************************
'Set the object variable to Nothing.
Set fd = Nothing
For Each ws In Worksheets
ws.Calculate
Next ws
Application.Calculation = xlCalculationAutomatic
End Sub

 

[BrianMH]

That functionality has been removed in windows 7.

I googled and found this thread that may help.

Application.filesearch Replacement For Office 2007

 

[snb_]

It has nothing to do with the operating system but everything with your office version. Filesearch has been removed since office 2007.

Please wrap VBA code in code tags

To retrieve all xls files in directory G:\OF you can use:

Sub M_snb()
  c00="G:\OF\"
  c01 ="xls"
  sn=split(createobject("wscript.shell").exec("cmd /c Dir """ & c00 & "*." & c01 &""" /b").stdout.readall),vbcrlf)

  for j=0 to ubound(sn)
    with getobject(iif(instr(sn(j),":"),"",c00) & sn(j)
' perform the copy operations
      .close true
    end with
  next
End Sub

 

[BrianMH]

It has nothing to do with the operating system but everything with your office version. Filesearch has been removed since office 2007.

Please wrap VBA code in code tags

Oops this is correct. Too late to edit my post but it should read "That functionality has been removed in office 2007+"

 

[snb_]

Amended code

Sub M_snb()
  c00="G:\OF\"
  c01 ="xls"
  sn=split(createobject("wscript.shell").exec("cmd /c Dir """ & c00 & "*." & c01 &""" /b").stdout.readall,vbcrlf)

  for j=0 to ubound(sn)
    with getobject(iif(instr(sn(j),":"),"",c00) & sn(j))
 '  perform the copy operations
      .close true
    end with
  next
End Sub

 

[snb_]

crossposted here:

Need Help on : Application.Filesearch