Tech Talk

please use this script to add all the csv files in a folder to a single excel workbook

Code: Select all

'##########Script by Praveen#####################
strTemplateFile = "c:\scripts\praveen.xls" ' create a template file praveen.xls under the script folder
Set objExcel = CreateObject("Excel.Application")
Const xlUp = -4162
Const xlDown = -4121
Const xlAnd = 1
objExcel.Visible = True
objExcel.Workbooks.Open strTemplateFile
Set objTemplateWB = objExcel.ActiveWorkbook

strComputer = "."
Set objWMI Service = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\   " & strComputer & "\root\cimv2")

Set FileList = objWMIService.ExecQuery _
    ("ASSOCIATORS OF {Win32_Directory.Name='c:\scripts'} Where " _
        & "ResultClass = CIM_DataFile")
For Each objFile In FileList
    If objFile.Extension = "csv" Then
    objExcel.Workbooks.Open ("c:\scripts\" & objfile.filename & "." & "csv")
   

      Set objCSVWB = objExcel.ActiveWorkbook
      objTemplateWB.Worksheets.Add
      objTemplateWB.Sheets(1).Name = objfile.filename
      objCSVWB. Sheets(1).UsedRange. Copy objTemplateWB. Sheets(1).Cells(65536,  "A").End(xlUp).Offset(1, 0)
      objCSVWB.Activate
      objExcel.ActiveWorkbook.Close False
      x=x+1
          End If
Next

      objTemplateWB.Activate
      objExcel.ActiveWorkbook.SaveAs objExcel.ActiveWorkbook.Path & "\" & Replace(objExcel.ActiveWorkbook.Name, ".xls", "") & "_" & FormatDateToString(Now) & ".xls"
      objExcel.ActiveWorkbook.Close False
         objExcel.Quit
     
Function FormatDateToString(dDateTime)
      FormatDateToString =      Year(dDateTime) & "-" &_
                        Right("00" & Month(dDateTime), 2) & "-" &_
                        Right("00" & Day(dDateTime), 2) & "-" &_
                        Right("00" & Hour(dDateTime), 2) & "-" &_
                        Right("00" & Minute(dDateTime), 2) & "-" &_
                        Right("00" & Second(dDateTime), 2)
End Function