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
objExcel.Workbooks.Add
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


    Next
   End If
Next

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


output-23-10.xlsx  (sheet1) and Toxls.vbs script  is attached for reference .
Input.xlsx
output-23-10.xlsx
kpconsultantAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Does this work for you?

' 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\sktneer\Desktop\Input.txt")
strInputExcelFile = objFSO.GetAbsolutePathname("C:\Users\sktneer\Desktop\Input.xlsx")
strOutputFile = objFSO.GetAbsolutePathname("C:\Users\sktneer\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
objexcel.Application.SheetsInNewWorkbook = 3
Set dwb = objExcel.Workbooks.Add
Set objSheet = dwb.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


    Next
   End If
Next

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

'Setting Sheet2 in strOutFile as destination sheet to hold the data from Sheet1 in Input.xlsx File
Set objSheet = objExcel.ActiveWorkbook.Worksheets(2)

'*********************************
'Copying the data from Input.xlsx
'*********************************

Set swb=objexcel.Workbooks.Open(strInputExcelFile)
Set sws=swb.Worksheets(1)

sws.range("A1").currentregion.copy objsheet.range("A1")

swb.Close False
dwb.Close True
objExcel.Quit
MsgBox "Task completed!"

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
kpconsultantAuthor Commented:
Thanks a lot for your help ! Your solution  and timeliness is much appreciated.
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic.NET

From novice to tech pro — start learning today.