Sunday, April 5, 2015

Going to directory, finding excel files and copy the excel sheet into a new excel file

'file extension to look for
extension = "xlsx" 

  'directory to look in
'strDirectory = InputBox("Enter the Folder Path:","Folder Path") 

  strDirectory = "C:\Users\ARUN\Desktop\Excel Merger Project"

counter = 0
  'File Objects Initialization
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(strDirectory)

counter = 0

set wbDst = objExcel.workbooks.open(strFileName) 'strFileName - empty file opened sometime back

For Each objFile In objFolder.Files 

  if LCase((objFSO.GetExtensionName(objFile))) = LCase(extension) then 

  counter = counter + 1

'Get the file name
  FileName = objFile.Name        

FileName = strDirectory & "\" & FileName msgbox(FileName)

set wbSrc = objExcel.workbooks.open(FileName)

wbSrc.sheets(wbSrc.Sheets(1).Name).copy wbDst.sheets(counter)

end if
Next

objWorkbook.SaveAs(strFileName) 'strFileName - is the empty excel file created sometime back

objExcel.Quit







 

No comments:

Post a Comment