Sub CleanXL4Poppy()
Dim i As Long
i = 1
'---------
Dim fs
Dim mypath As String
Dim theSh As Object
Dim theFolder As Object
Set theSh = CreateObject("shell.application")
Set theFolder = theSh.BrowseForFolder(0, "", 0, "")
If Not theFolder Is Nothing Then
mypath = theFolder.Items.Item.Path
End If
'---------------
Dim str As String
If Len(Trim(ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Value)) <= 0 Then
str = "*" + ".xls"
Else
str = ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Value + ".xls"
End If
File_Search mypath, str, i
'"C:\Documents and Settings\Administrator\Desktop\ChungTuCo Macro", "*.xls", i
End Sub
Sub combine(Fpath As String, ByVal Fname As String, ByRef i As Long)
Dim nName As Name
Fname = Dir(Fpath & "\" & Fname)
On Error Resume Next
ThisWorkbook.Worksheets("Sheet1").Cells(8, 3).Value = "List of the files was cleaned Marco"
ThisWorkbook.Worksheets("Sheet1").Cells(8, 3).Font.ColorIndex = 3
Do While Fname <> ""
On Error Resume Next
Workbooks.Open Fpath & "\" & Fname
Application.DisplayAlerts = False
Sheets("XL4Poppy").Delete
ThisWorkbook.Worksheets("Sheet1").Cells(i + 9, 3).Value = Fpath & "\" & Fname
For Each nName In Names
If InStr(1, nName.Value, "#REF") Then
nName.Delete
End If
Next nName
'ActiveWorkbook.Names("p*").Delete
Application.DisplayAlerts = True
Workbooks(Fname).Close SaveChanges:=True
Fname = Dir
i = i + 1
Loop
'-------
End Sub
Sub File_Search(rootpath As String, ByVal filename As String, ByRef i As Long)
Dim DocName As String
Dim Search_Filter As String
combine rootpath, ByVal filename, i
Dim fs, f, s
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(rootpath)
Dim subfolder
Dim rootpathx As String
Set subfolder = f.subfolders
For Each f1 In subfolder
rootpathx = rootpath & "\" & f1.Name
File_Search rootpathx, ByVal filename, i
Next
End Sub