Saturday 29 August 2015

Extract data from into Excel and hyperlink worsheets baseed in file names


Scripts:

filepath = "C:\Users\venu\Desktop\test\files"
set fso = CreateObject("Scripting.FileSystemObject")
set folder = fso.getFolder(filepath)
set files = folder.Files
arrColumns = Array("Col1", "Col2", "Col3")
delimiter = ","
cnt = CInt(files.count)-2
If cnt>0 Then
        set exl = CreateObject("Excel.Application")       
        exl.visible = false
        set objWorkbook = exl.workbooks.Add()
        set objSheets = objWorkbook.sheets
        objSheets.Add , , cnt
        objSheets("Sheet1").name = "Config"
       
        ''Set the header in Config sheet..
        With exl.sheets.item("Config")               
            .cells(1, 1) = "FileDescription"   
            .cells(1, 1).Font.Bold = true
            .cells(1, 1).Interior.ColorIndex = 10  '' 16=brown, 10= green,
            .cells(1, 1).Borders.LineStyle = 1
        End With
           
        i = 2  '' To start printing the data from second row in each sheet..
        iConfig = 2  ''to place the data in config sheet based on text files count
        for each file in files
            ''msgbox file.name
            filename = Split(file.name, ".")(0)
            ''Rename the sheet names based on file names
            objSheets("Sheet"&i).name = filename
           
            ''Get file names into Config sheet for linking sheets with file names in config sheet
            set configSheet = exl.sheets.item("Config")               
                configSheet.cells(iConfig, 1) = filename   
                '' Hyperlink worksheets from Config file..
                configSheet.Hyperlinks.Add configSheet.Cells(iConfig, 1),"", "'" & filename & "'!A1"               
                iConfig = iConfig + 1
            set configSheet = Nothing
           
            ''Set the control to the required sheet based on file name..
            set ws = exl.sheets.item(filename)
            ''Set Headers for each file in respective sheet
            Col = 1
            for each ele in arrColumns
                ws.cells(1, col) = ele
                ws.cells(1, col).Font.Bold = true
                ws.cells(1, col).Interior.ColorIndex = 10  '' 16=brown, 10= green,
                ws.cells(1, col).Borders.LineStyle = 1
                col = col+1
            Next
           
            ''Now read the file content and set the data in respective sheets..
            rowNo = 2
           
            ''Read the text file and update the respective sheets based on file name..
            set objTextFile = fso.openTextFile(file, 1)
            Do Until objTextFile.AtEndOfStream
                colNo = 1
                strLine = objTextFile.Readline
                If Trim(strLine) <> "" And Len(Trim(strLine)) Then
                    arrData = split(strLine, ",")
                    for each ele in arrData
                        ws.cells(rowNo, colNo) = Trim(ele)
                        ws.cells(rowNo, colNo).Borders.LineStyle = 1
                        colNo = colNo+1
                    Next
                    rowNo = rowNo + 1
                End If               
            Loop
            objTextFile.close
            set objTextFile = Nothing           
            i = i+1
        Next
        exl.ActiveWorkBook.SaveAs("C:\Users\venu\Desktop\test\Testing.xlsx")
        exl.quit
        Set exl = Nothing       
End If
set fso = Nothing
OutPut:




No comments:

Post a Comment