Replace value on several Excel files

I’ve written this code for a user that wanted to change a value in hundreds of Excel files that where in several sub folders under a main folder. This code will go through the main folder C:\Test and will replace the value on cell A1 on Sheet1 of every Excel file it will find. You can adapt this code by changing the folder name, cell destination or sheet name.

Sub Change_Value_On_Files()

    Dim fso, folder, files, NewsFile, sFolderSet
    objExcel = CreateObject("Excel.Application")
    objExcel.Visible = TrueSet
    fso = CreateObject("Scripting.FileSystemObject")
    sFolder = "C:\Test"
    Set folder = fso.GetFolder(sFolder)
    Set files = folder.files
    For Each SubFolder In folder.SubFolders
        For Each folderIdx In SubFolder.files
            If Right(folderIdx, 4) = ".xls" Then
                Set objWorkbook = objExcel.Workbooks.Open(folderIdx)
                Set objWorksheet = objWorkbook.Worksheets(1)
                Set objRange = objWorksheet.Range("A1")
                objRange.Range("A1").Value = "YOUR VALUE HERE!"
                objWorkbook.Close True
            End If

End Sub

0 comentários: