Dear ALL
I trying to make a code that go through each excel file in folder and change background to no fill,the code runs but after some times having error object required
Public Sub btnGetSheets_Click()
Call GetSheets("c:\source")
End Sub
Public Sub GetSheets(ByVal strPath As String)
On Error GoTo Proc_Error
'MUST set reference to Windows Script Host Object Model in the project to use this code!
Dim objFS As FileSystemObject
Dim objFolder As Folder
Dim objFile As File
Dim wksCurr As Worksheet
Dim wksTest As Worksheet
Dim strFilePath As String
Dim strFile As String
Dim strValidFile As String
Dim intSheet As Integer
Set objFS = New FileSystemObject
Set objFolder = objFS.GetFolder(strPath)
Application.EnableEvents = False
'
' Look at each file in the folder
'
For Each objFile In objFolder.Files
strPath = objFile.Path
strFile = objFile.Name
If (Right(strFile, 3) = "xls" _
Or Right(strFile, 4) = "xlsx" _
Or Right(strFile, 4) = "xlsm") Then
'
' Update the name and date entries for the current worksheet
'
Application.Workbooks.Open strPath, False, False
With Application
.FindFormat.Clear
.FindFormat.Interior.ColorIndex = 2
.ReplaceFormat.Clear
.ReplaceFormat.Interior.ColorIndex = xlNone
End With
For Each wksCurr In Workbooks(strFile).Worksheets
For Each wksTest In Workbooks(strFile).Worksheets
wks.Cells.Replace What:="", Replacement:="", _
LookAt:=xlWhole, MatchCase:=True, _
SearchFormat:=True, ReplaceFormat:=True
Exit For
'End If
Next wksTest
wksCurr.Name = "Sheet" & wksCurr.Index
Next wksCurr
Application.Workbooks(strFile).Close True
End If
Next objFile
Proc_Exit:
Application.EnableEvents = True
Set objFile = Nothing
Set objFolder = Nothing
Set objFS = Nothing
Exit Sub
Proc_Error:
Select Case Err
Case Else
MsgBox "Error " & CStr(Err) & ": " & Err.Description
' Resume Next_Sheet
End Select
End Sub
Thanks
farrukh
Bookmarks