Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 351
  • Last Modified:

VB Script parsing data, getting Error message

Good Afternoon Experts, I need some help with a code I created.  I am parsing out a text file and placing it in Excel on seperate sheets. In my attempt to do so, I get an error 'Subscript Out of Range' I have never seen it before, but is pointing to this line of code: "Set ws1 = wbs.workSheets(XA)".  Here is the full code:  Can anyone help please

excel.Visible = false

excel.Workbooks.Add

Set objFSO = CreateObject("Scripting.FileSystemObject")

  Set wbs = excel.Workbooks.Open(sXLS)
 
  'Add Spreadsheet to Workbook
 
  excel.WorkSheets(1).Name = "XA"
  excel.WorkSheets(2).Name = "XB"
  excel.WorkSheets(3).Name = "XC"
 
 
  row = 2
 
  Set ws1 = wbs.workSheets(XA) 'Setup variable worksheet
  Set ws2 = wbs.workSheets(XB)
  Set ws3 = wbs.workSheets(XC)

 
 
  Set objFile = objFSO.OpenTextFile(ObjDialog.FileName, 1, True)
 
  Do While Not objFile.AtEndOfStream
 
    sText = objFile.ReadLine

'Wscript.Echo
0
drezner7
Asked:
drezner7
  • 8
  • 7
1 Solution
 
Chris BottomleyCommented:
Set ws1 = wbs.workSheets("XA") 'Setup variable worksheet
 Set ws2 = wbs.workSheets("XB")
 Set ws3 = wbs.workSheets("XC")
0
 
drezner7Author Commented:
Thank you Chris, How would i write the code so when the data gets entered in say table XB it begins in row 2? It places the data but it places it in the same line it found it example line 12,556..
0
 
Chris BottomleyCommented:
It places the data but it places it in the same line it found it example line 12,556..

Bit of an open question really since you provide no code but for example:

ws1.range("a" & rw) = datum

I have used rw rather than row as it easy to confuse row the variable with row the property ... i.e. rw = 2 and then increment it each iteration ... if in a loop.

Chris
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
drezner7Author Commented:
I am sorry for not providing the code... Here is what I have:

Set excel = WScript.CreateObject ("Excel.Application")

'Make excel open in the browser screen yes or no
excel.Visible = false

excel.Workbooks.Add

Set objFSO = CreateObject("Scripting.FileSystemObject")


  Set wbs = excel.Workbooks.Open(sXLS)
 
  'Add Spreadsheet to Workbook
 
  excel.WorkSheets(1).Name = "XA"
  excel.WorkSheets(2).Name = "XB"
  excel.WorkSheets(3).Name = "XC"
 
 

 
  Set ws1 = wbs.workSheets("XA") 'Setup variable worksheet
  Set ws2 = wbs.workSheets("XB")
  Set ws3 = wbs.workSheets("XC")

 
 
  Set objFile = objFSO.OpenTextFile(ObjDialog.FileName, 1, True)
 
  Do While Not objFile.AtEndOfStream
 
    sText = objFile.ReadLine

'Wscript.Echo

  row = 2
   
If Trim(Left(sText, 4)) = "XA" Then

   ws1.Range("A" & row).Value = mid(sText,1, 4)
   ws1.Range("B" & row).Value = mid(sText,5, 10)
   

    End if
 
If Trim(Left(sText, 4)) = "XB" Then

    ws2.Range("A" & row).Value = mid(sText,1, 4)
    ws2.Range("B" & row).Value = mid(sText,5, 10)
    ws2.Range("C" & row).Value = mid(sText,15, 18)
    ws2.Range("D" & row).Value = mid(sText,33, 2)
    ws2.Range("E" & row).Value = mid(sText,35, 1)
    ws2.Range("F" & row).Value = mid(sText,36, 1)
    ws2.Range("G" & row).Value = mid(sText,37, 19)
    ws2.Range("H" & row).Value = mid(sText,56, 11)
    ws2.Range("H" & row).Value = mid(sText,67, 1)
   
    End if





    row = row+1
  Loop

  objFile.Close
  excel.DisplayAlerts = False
  wbs.Save
  wbs.Close 0
  excel.DisplayAlerts = true
0
 
Chris BottomleyCommented:
I doubt you ned the line:

excel.Workbooks.Add
try deleting it i.e.
'excel.Workbooks.Add

As for the output ... it should go to the row 2 entry but try changing the variable row to rw as I suggested and see if it helps

Chris
0
 
drezner7Author Commented:
Here is what I changed, but it does not work now:

rw = 2
   
If Trim(Left(sText, 4)) = "XA" Then

   ws1.Range("A" & rw).Value = mid(sText,1, 4)
   ws1.Range("B" & rw).Value = mid(sText,5, 10)
   

    End if
 
If Trim(Left(sText, 4)) = "XB" Then

    ws2.Range("A" & rw).Value = mid(sText,1, 4)
    ws2.Range("B" & rw).Value = mid(sText,5, 10)
    ws2.Range("C" & rw).Value = mid(sText,15, 18)
    ws2.Range("D" & rw).Value = mid(sText,33, 2)
    ws2.Range("E" & rw).Value = mid(sText,35, 1)
    ws2.Range("F" & rw).Value = mid(sText,36, 1)
    ws2.Range("G" & rw).Value = mid(sText,37, 19)
    ws2.Range("H" & rw).Value = mid(sText,56, 11)
    ws2.Range("H" & rw).Value = mid(sText,67, 1)
   
    End if

    rw = rw+1
   
  Loop
0
 
Chris BottomleyCommented:
sXLS is not visible as a variable so at the moment I would say it is not actually opening anything, i added a draft line of what I would expect ish.

I also prefixed the sheet naming with the workbook wbs instead of excel application.

Chris
Set excel = WScript.CreateObject ("Excel.Application")

'Make excel open in the browser screen yes or no
excel.Visible = false

'excel.Workbooks.Add

Set objFSO = CreateObject("Scripting.FileSystemObject")
sXLS = "c:\deleteme\myfile.xls"

  Set wbs = excel.Workbooks.Open(sXLS)
  
  'Add Spreadsheet to Workbook
  
  wbs.WorkSheets(1).Name = "XA"
  wbs.WorkSheets(2).Name = "XB"
  wbs.WorkSheets(3).Name = "XC"
  
  

  
  Set ws1 = wbs.workSheets("XA") 'Setup variable worksheet
  Set ws2 = wbs.workSheets("XB")
  Set ws3 = wbs.workSheets("XC")

  
  
  Set objFile = objFSO.OpenTextFile(ObjDialog.FileName, 1, True)
  
  Do While Not objFile.AtEndOfStream
  
    sText = objFile.ReadLine

'Wscript.Echo

  rw = 2
   
If Trim(Left(sText, 4)) = "XA" Then

   ws1.Range("A" & rw).Value = mid(sText,1, 4) 
   ws1.Range("B" & rw).Value = mid(sText,5, 10) 
    

    End if
  
If Trim(Left(sText, 4)) = "XB" Then

    ws2.Range("A" & rw).Value = mid(sText,1, 4) 
    ws2.Range("B" & rw).Value = mid(sText,5, 10) 
    ws2.Range("C" & rw).Value = mid(sText,15, 18) 
    ws2.Range("D" & rw).Value = mid(sText,33, 2) 
    ws2.Range("E" & rw).Value = mid(sText,35, 1) 
    ws2.Range("F" & rw).Value = mid(sText,36, 1) 
    ws2.Range("G" & rw).Value = mid(sText,37, 19) 
    ws2.Range("H" & rw).Value = mid(sText,56, 11) 
    ws2.Range("H" & rw).Value = mid(sText,67, 1) 
    
    End if





    rw = rw+1
  Loop

  objFile.Close 
  excel.DisplayAlerts = False
  wbs.Save
  wbs.Close 0
  excel.DisplayAlerts = true

Open in new window

0
 
drezner7Author Commented:
it is still not working: It only pulls the fulls table XA correctly, but with XB record it is only pulling the last record on the list.


Option Explicit

'Variables
Dim sFile, sXLS, excel, objFSO, objFile, wbs, ws, sText, row, strPath, strCommand, objShell, objDialog, intResult, XA, XB, XC, ws1, ws2, ws3

'Prompt C:\ Console Window
    If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Wscript.Echo "Select File For Uploading"

'Open File Browser
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Files|*.txt|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:\Sample"
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
    Wscript.Quit

End If

'sFile = "C:\Sample\input.txt"

'Output File Location
sXLS = "C:\Sample\TableSplit.xlsx"

Set excel = WScript.CreateObject ("Excel.Application")

'Make excel open in the browser screen yes or no
excel.Visible = false

'excel.Workbooks.Add

Set objFSO = CreateObject("Scripting.FileSystemObject")


  Set wbs = excel.Workbooks.Open(sXLS)
 
  'Add Spreadsheet to Workbook
 
  wbs.WorkSheets(1).Name = "XA"
  wbs.WorkSheets(2).Name = "XB"
  wbs.WorkSheets(3).Name = "XC"
 
 

 'Setup variable worksheet
  Set ws1 = wbs.workSheets("XA")
  Set ws2 = wbs.workSheets("XB")
  Set ws3 = wbs.workSheets("XC")

 
 
  Set objFile = objFSO.OpenTextFile(ObjDialog.FileName, 1, True)
 
  Do While Not objFile.AtEndOfStream
 
    sText = objFile.ReadLine

'Wscript.Echo

rw = 2
   
If Trim(Left(sText, 4)) = "XA" Then

   ws1.Range("A" & rw).Value = mid(sText,1, 4)
   ws1.Range("B" & rw).Value = mid(sText,5, 10)
   

    End if
 
If Trim(Left(sText, 4)) = "XB" Then

    ws2.Range("A" & rw).Value = mid(sText,1, 4)
    ws2.Range("B" & rw).Value = mid(sText,5, 10)
    ws2.Range("C" & rw).Value = mid(sText,15, 18)
    ws2.Range("D" & rw).Value = mid(sText,33, 2)
    ws2.Range("E" & rw).Value = mid(sText,35, 1)
    ws2.Range("F" & rw).Value = mid(sText,36, 1)
    ws2.Range("G" & rw).Value = mid(sText,37, 19)
    ws2.Range("H" & rw).Value = mid(sText,56, 11)
    ws2.Range("H" & rw).Value = mid(sText,67, 1)
   
    End if





    rw = rw+1
   
  Loop

  objFile.Close
  excel.DisplayAlerts = False
  wbs.Save
  wbs.Close 0
  excel.DisplayAlerts = true
0
 
Chris BottomleyCommented:
Are you expecting data for XA to be sequential and then to get to Xb data and restart at row 2 of XB?

Chris
Option Explicit

'Variables
Dim sFile, sXLS, excel, objFSO, objFile, wbs, ws, sText, row, strPath, strCommand, objShell, objDialog, intResult, XA, XB, XC, ws1, ws2, ws3

'Prompt C:\ Console Window
    If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Wscript.Echo "Select File For Uploading"

'Open File Browser
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Files|*.txt|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:\Sample"
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
    Wscript.Quit

End If

'sFile = "C:\Sample\input.txt"

'Output File Location
sXLS = "C:\Sample\TableSplit.xlsx"

Set excel = WScript.CreateObject ("Excel.Application")

'Make excel open in the browser screen yes or no
excel.Visible = false

'excel.Workbooks.Add

Set objFSO = CreateObject("Scripting.FileSystemObject")


  Set wbs = excel.Workbooks.Open(sXLS)
  
  'Add Spreadsheet to Workbook
  
  wbs.WorkSheets(1).Name = "XA"
  wbs.WorkSheets(2).Name = "XB"
  wbs.WorkSheets(3).Name = "XC"
  
  

 'Setup variable worksheet 
  Set ws1 = wbs.workSheets("XA")
  Set ws2 = wbs.workSheets("XB")
  Set ws3 = wbs.workSheets("XC")

  
  
  Set objFile = objFSO.OpenTextFile(ObjDialog.FileName, 1, True)
  
  Do While Not objFile.AtEndOfStream
  
    sText = objFile.ReadLine

'Wscript.Echo

rwXA = 2
rwXB = 2
   
If Trim(Left(sText, 4)) = "XA" Then

   ws1.Range("A" & rw).Value = mid(sText,1, 4) 
   ws1.Range("B" & rw).Value = mid(sText,5, 10) 
   rwXA = rwXA+1
End if
  
If Trim(Left(sText, 4)) = "XB" Then

    ws2.Range("A" & rw).Value = mid(sText,1, 4) 
    ws2.Range("B" & rw).Value = mid(sText,5, 10) 
    ws2.Range("C" & rw).Value = mid(sText,15, 18) 
    ws2.Range("D" & rw).Value = mid(sText,33, 2) 
    ws2.Range("E" & rw).Value = mid(sText,35, 1) 
    ws2.Range("F" & rw).Value = mid(sText,36, 1) 
    ws2.Range("G" & rw).Value = mid(sText,37, 19) 
    ws2.Range("H" & rw).Value = mid(sText,56, 11) 
    ws2.Range("H" & rw).Value = mid(sText,67, 1) 
    rwXB = rwXB+1
    
End if

  Loop

  objFile.Close 
  excel.DisplayAlerts = False
  wbs.Save
  wbs.Close 0
  excel.DisplayAlerts = true

Open in new window

0
 
drezner7Author Commented:
Error" Unkown runtime error' in this line:

ws1.Range("A" & rw).Value = mid(sText,1, 4)
0
 
Chris BottomleyCommented:
Would have made more sense to respond to the assumption itself o I know if the change is worthwhile ... but corrected the snippet anyway
Option Explicit

'Variables
Dim sFile, sXLS, excel, objFSO, objFile, wbs, ws, sText, rwXA, rwXB, strPath, strCommand, objShell, objDialog, intResult, XA, XB, XC, ws1, ws2, ws3

'Prompt C:\ Console Window
    If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Wscript.Echo "Select File For Uploading"

'Open File Browser
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Files|*.txt|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:\Sample"
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
    Wscript.Quit

End If

'sFile = "C:\Sample\input.txt"

'Output File Location
sXLS = "C:\Sample\TableSplit.xlsx"

Set excel = WScript.CreateObject ("Excel.Application")

'Make excel open in the browser screen yes or no
excel.Visible = false

'excel.Workbooks.Add

Set objFSO = CreateObject("Scripting.FileSystemObject")


  Set wbs = excel.Workbooks.Open(sXLS)
  
  'Add Spreadsheet to Workbook
  
  wbs.WorkSheets(1).Name = "XA"
  wbs.WorkSheets(2).Name = "XB"
  wbs.WorkSheets(3).Name = "XC"
  
  

 'Setup variable worksheet 
  Set ws1 = wbs.workSheets("XA")
  Set ws2 = wbs.workSheets("XB")
  Set ws3 = wbs.workSheets("XC")

  
  
  Set objFile = objFSO.OpenTextFile(ObjDialog.FileName, 1, True)
  
  Do While Not objFile.AtEndOfStream
  
    sText = objFile.ReadLine

'Wscript.Echo

rwXA = 2
rwXB = 2
   
If Trim(Left(sText, 4)) = "XA" Then

   ws1.Range("A" & rwXA).Value = mid(sText,1, 4) 
   ws1.Range("B" & rwXA).Value = mid(sText,5, 10) 
   rwXA = rwXA+1
End if
  
If Trim(Left(sText, 4)) = "XB" Then

    ws2.Range("A" & rwXB).Value = mid(sText,1, 4) 
    ws2.Range("B" & rwXB).Value = mid(sText,5, 10) 
    ws2.Range("C" & rwXB).Value = mid(sText,15, 18) 
    ws2.Range("D" & rwXB).Value = mid(sText,33, 2) 
    ws2.Range("E" & rwXB).Value = mid(sText,35, 1) 
    ws2.Range("F" & rwXB).Value = mid(sText,36, 1) 
    ws2.Range("G" & rwXB).Value = mid(sText,37, 19) 
    ws2.Range("H" & rwXB).Value = mid(sText,56, 11) 
    ws2.Range("H" & rwXB).Value = mid(sText,67, 1) 
    rwXB = rwXB+1
    
End if

  Loop

  objFile.Close 
  excel.DisplayAlerts = False
  wbs.Save
  wbs.Close 0
  excel.DisplayAlerts = true

Open in new window

0
 
drezner7Author Commented:
It is stil not parsing it correctly.  The parsing reads as follows in a text file: The first row of data is XA the next 300 rows is XB. Yes, your assumption is correct that it begins with XA, once complete it moves to row 2 in the XB worksheet to populate all the XB records.

The issue that is occuring, is that when it goes to read XB it only pulls the last record from the text file (line 300) to row 2 in the XB worksheet.

I really appreciate all of your help you have given me.
0
 
Chris BottomleyCommented:
What you need to bear in mind is that the original question was in regard to subscript out of range on the worksheet assignment whereas the current activity has digressed to debug my code.  I have not therefore made a determined examination of the code for errors.  That said I have looked to see what else is strange ... and apart from the use of trim to render 4 characters into 2 and the assumption therefore that each row of interest starts with these characters and some spaces as well as the fact that these characters MUST be caps I do note:

IN your original code the var inits were inside the loop ... moved them outside which should help.

Chris
Option Explicit

'Variables
Dim sFile, sXLS, excel, objFSO, objFile, wbs, ws, sText, rwXA, rwXB, strPath, strCommand, objShell, objDialog, intResult, XA, XB, XC, ws1, ws2, ws3

'Prompt C:\ Console Window
    If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Wscript.Echo "Select File For Uploading"

'Open File Browser
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Files|*.txt|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:\Sample"
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
    Wscript.Quit

End If

'sFile = "C:\Sample\input.txt"

'Output File Location
sXLS = "C:\Sample\TableSplit.xlsx"

Set excel = WScript.CreateObject ("Excel.Application")

'Make excel open in the browser screen yes or no
excel.Visible = false

'excel.Workbooks.Add

Set objFSO = CreateObject("Scripting.FileSystemObject")


  Set wbs = excel.Workbooks.Open(sXLS)
  
  'Add Spreadsheet to Workbook
  
  wbs.WorkSheets(1).Name = "XA"
  wbs.WorkSheets(2).Name = "XB"
  wbs.WorkSheets(3).Name = "XC"
  
  

 'Setup variable worksheet 
  Set ws1 = wbs.workSheets("XA")
  Set ws2 = wbs.workSheets("XB")
  Set ws3 = wbs.workSheets("XC")

  
  
  Set objFile = objFSO.OpenTextFile(ObjDialog.FileName, 1, True)
  
rwXA = 2
rwXB = 2
   
  Do While Not objFile.AtEndOfStream
  
    sText = objFile.ReadLine

'Wscript.Echo

If Trim(Left(sText, 4)) = "XA" Then

   ws1.Range("A" & rwXA).Value = mid(sText,1, 4) 
   ws1.Range("B" & rwXA).Value = mid(sText,5, 10) 
   rwXA = rwXA+1
End if
  
If Trim(Left(sText, 4)) = "XB" Then

    ws2.Range("A" & rwXB).Value = mid(sText,1, 4) 
    ws2.Range("B" & rwXB).Value = mid(sText,5, 10) 
    ws2.Range("C" & rwXB).Value = mid(sText,15, 18) 
    ws2.Range("D" & rwXB).Value = mid(sText,33, 2) 
    ws2.Range("E" & rwXB).Value = mid(sText,35, 1) 
    ws2.Range("F" & rwXB).Value = mid(sText,36, 1) 
    ws2.Range("G" & rwXB).Value = mid(sText,37, 19) 
    ws2.Range("H" & rwXB).Value = mid(sText,56, 11) 
    ws2.Range("H" & rwXB).Value = mid(sText,67, 1) 
    rwXB = rwXB+1
    
End if

  Loop

  objFile.Close 
  excel.DisplayAlerts = False
  wbs.Save
  wbs.Close 0
  excel.DisplayAlerts = true

Open in new window

0
 
drezner7Author Commented:
You are correct, next time I will submit another question for it, if that helps. I really appreciate all of the help you have given me. You rock ! they should give you an award or something. I am now able to parse 600,000 lines of data in about an 1hr versus 3 weeks manually.

Thank you so much.
0
 
Chris BottomleyCommented:
Glad it helped, my point was primarily that the question didn't imply a need to debug code, that said you will tend to get a better involvement from the experts when a question is 'small' enough to answer easily.

That said it is also fine to seek debugging help as in this case ... just emphasise that the help needed is for the overall code block.

Awards are neither here nor there, helping someone is the real reward.  Besides there are the T shirts and other such that reward us.  Also if there are much better experts than I who would merit them so I as with a lot of experts am simply happy with askers who are considerate of us 'experts' so thanks and see you around perhaps.

Chris
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 8
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now