Link to home
Start Free TrialLog in
Avatar of kp

asked on

Copying xlsx hard-coded data to an excel sheet

I have got  an additional  requirement to save hard-coded data from excel sheet (Input.xlsx) (attached)   to a  excel sheet (in sheet 2 of output-23-10.xlsx) being  generated out of  below vbscript (Toxls.vbs) .

Looking to add  new functionality in  an existing utility vbscript (Toxls.vbs)  to achieve  copying hard-coded data from excel (Input.xlsx) to a  excel sheet (sheet2 of output-23-10.xlsx )   being generated from below vbscript  vbscript (Toxls.vbs) .  

Toxls.vbs :- Used to convert Pipe Delimited text into an excel sheet (Output.xlsx).

' Define constants
Const cExcel7 = 51
Const xlContinuous = 1
Const xlEdgeBottom = 9
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8

' Create file system object
Set objFSO = CreateObject("Scripting.FilesystemObject")

' Files to work woth
strInputFile = objFSO.GetAbsolutePathname("C:\Users\user\Desktop\Input.txt")
strOutputFile = objFSO.GetAbsolutePathname("C:\Users\user\Desktop\output-23-10.xlsx")

' Read text file into array
With objFSO.OpenTextFile(strInputFile, 1)
    arrInput = Split(.ReadAll, vbNewLine)
End With

' Start Excel, create a new worksheet
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' Initialize row index
intRow = 0

' Process each line of input file
For Each strInput in arrInput

    ' Skip all blank lines
    If strInput <> "" Then
        ' Start a new row in Excel, start at first column
        intRow = intRow + 1
        intCol = 0

        ' Parse input text line
        arrTokens = Split(strInput, "|")

        ' Add each value to Excel sheet
        For Each strToken In arrTokens
            intCol = intCol + 1
            With objSheet.Cells(intRow, intCol)
                .Value = Trim(strToken)

                ' Bold first row
                If intRow = 1 Then
                    .Font.Bold = True
                End If

                ' Borders on all cells
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeRight).LineStyle = xlContinuous
            End With

   End If

' Write file and close Excel
objExcel.DisplayAlerts = False
objExcel.ActiveWorkbook.SaveAs strOutputFile, cExcel7
objExcel.ActiveWorkbook.Close False

output-23-10.xlsx  (sheet1) and Toxls.vbs script  is attached for reference .
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of kp


Thanks a lot for your help ! Your solution  and timeliness is much appreciated.
You're welcome!