Solved

Posted on 2011-10-17

I am trying to read a text file that has fixed length and then exporting it to Excel via a vsbcript. For example line 1 in the text file would be:

```
HA 12345 6789 10111213
HB Spoon fork torch
```

Here is what I have for a vsbscript code, but I am stuck somewhere:```
Option Explicit
Dim oFSO, sFile, oFile, sText, sXLS, oOut
sFile = "C:\Sample\test.txt"
sXLS = "C:\Sample\testouput.xlsx"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oOut = oFSO.CreateTextFile(sXLS, True)
If oFSO.FileExists(sFile) Then
Set oFile = oFSO.OpenTextFile(sFile, 1)
Do While Not oFile.AtEndOfStream
sText = oFile.ReadLine
If (sText) = "HA" Then
oOut.WriteLine (oSheet.Cells(Row, 1).Value)
End If
if Trim(sText) = "HB" Then
oOut.WriteLine (oSheet.Cells(Row, 2).Value)
End If
Exit Do
Loop
oFile.Close
End if
```

15 Comments

Readline will read the entire line. Comparing that line to be equal with some fragment will not succeed. One way to accomplish this is to compare only the first two chars:

```
sText = oFile.ReadLine
If left(sText,2) = "HA" Then
```

Next part, you do not want to use "oOut.WriteLine (oSheet.Cells(Row, 1).Value)" to write ```
Option Explicit
Dim excel, sFile, sXLS, oFSO, sText, row
sFile = "C:\Sample\test.txt"
sXLS = "C:\Sample\testouput.xlsx"
Set excel = WScript.CreateObject ("Excel.Application")
excel.Visible = false
Set oFSO = CreateObject("Scripting.FileSystemObject")
row = 1
If oFSO.FileExists(sFile) Then
Set wbs = excel.Workbooks.Open(sXLS)
Set ws = wbs.WorkSheets(1)
Set oFile = oFSO.OpenTextFile(sFile, 1)
Do While Not oFile.AtEndOfStream
sText = oFile.ReadLine
If Left(sText, 2) = "HA" then
ws.Range("A" & row).Value = sText
End If
If Left(sText, 2) = "HB" then
ws.Range("B" & row).Value = sText
End If
Loop
oFile.Close
Application.DisplayAlerts = False
wbs.Save
wbs.Close 0
Application.DisplayAlerts = true
End If
excel.quit
set excel = nothing
```

Thank you

FIxed Length:

colA = Left((oSheet.Cells(iRow, 1).Value)& Space(4),4)

colB = Left((oSheet.Cells(iRow, 2).Value)& Space(10),10)

colC = Left((oSheet.Cells(iRow, 3).Value)& Space(18),18)

colD = Left((oSheet.Cells(iRow, 4).Value)& Space(2),2)

colE = Left((oSheet.Cells(iRow, 5).Value)& Space(1),1)

colF = Left((oSheet.Cells(iRow, 6).Value)& Space(18),18)

colG = Left((oSheet.Cells(iRow, 7).Value)& Space(2),2)

colH = Left((oSheet.Cells(iRow, 8).Value)& Space(1),1)

colI = Left((oSheet.Cells(iRow, 9).Value)& Space(10),10)

colJ = Left((oSheet.Cells(iRow, 10).Value)& Space(10),10)

Input.txt TestOutput.xlsx

Thank you

```
Option Explicit
Dim excel, sFile, sXLS, oFSO, sText, row
sFile = "C:\Sample\test.txt"
sXLS = "C:\Sample\testoutput.xlsx"
Set excel = WScript.CreateObject ("Excel.Application")
excel.Visible = false
Set oFSO = CreateObject("Scripting.FileSystemObject")
row = 2
If oFSO.FileExists(sFile) Then
Set wbs = excel.Workbooks.Open(sXLS)
Set ws = wbs.WorkSheets(1)
Set oFile = oFSO.OpenTextFile(sFile, 1)
Do While Not oFile.AtEndOfStream
sText = oFile.ReadLine
ws.Range("A" & row).Value = getField(sText, 4)
ws.Range("B" & row).Value = getField(sText, 10)
ws.Range("C" & row).Value = getField(sText, 18)
ws.Range("D" & row).Value = getField(sText, 2)
ws.Range("E" & row).Value = getField(sText, 1)
ws.Range("F" & row).Value = getField(sText, 18)
ws.Range("G" & row).Value = getField(sText, 2)
ws.Range("H" & row).Value = getField(sText, 1)
ws.Range("I" & row).Value = getField(sText, 10)
ws.Range("J" & row).Value = getField(sText, 10)
row = row+1
Loop
oFile.Close
Application.DisplayAlerts = False
wbs.Save
wbs.Close 0
Application.DisplayAlerts = true
End If
excel.quit
set excel = nothing
Function getField(ByRef line As String, ByVal length As Integer) as String
getField = Left(line, length)
line = Mid$(line, length + 1)
End Function
```

Here is the line that is having the error

Function getField(ByRef line As String, ByVal length As Integer)

The code I provided has been writting in VBA, and obviously there are some changes applied which do not work in VBS. This code should do now:

```
Option Explicit
Dim sFile, sXLS, excel, oFSO, oFile, wbs, ws, sText, row
sFile = "C:\Sample\input.txt"
sXLS = "C:\Sample\testoutput.xlsx"
Set excel = WScript.CreateObject ("Excel.Application")
excel.Visible = false
Set oFSO = CreateObject("Scripting.FileSystemObject")
row = 2
If oFSO.FileExists(sFile) Then
Set wbs = excel.Workbooks.Open(sXLS)
Set ws = wbs.WorkSheets(1)
Set oFile = oFSO.OpenTextFile(sFile, 1)
Do While Not oFile.AtEndOfStream
sText = oFile.ReadLine
ws.Range("A" & row).Value = getField(sText, 4)
ws.Range("B" & row).Value = getField(sText, 10)
ws.Range("C" & row).Value = getField(sText, 10)
ws.Range("D" & row).Value = getField(sText, 18)
ws.Range("E" & row).Value = getField(sText, 2)
ws.Range("F" & row).Value = getField(sText, 1)
ws.Range("G" & row).Value = getField(sText, 18)
ws.Range("H" & row).Value = getField(sText, 2)
ws.Range("I" & row).Value = getField(sText, 1)
ws.Range("J" & row).Value = getField(sText, 10)
ws.Range("K" & row).Value = getField(sText, 10)
row = row+1
Loop
oFile.Close
excel.DisplayAlerts = False
wbs.Save
wbs.Close 0
excel.DisplayAlerts = true
End If
excel.quit
set excel = nothing
Function getField(ByRef line, ByVal length)
getField = Left(line, length)
line = Mid(line, length + 1)
End Function
```

if left(sText, 2) = "XE" then

ws.Range("A" & row).Value = getField(sText, 4)

ws.Range("B" & row).Value = getField(sText, 10)

ws.Range("C" & row).Value = getField(sText, 10)

ws.Range("D" & row).Value = getField(sText, 18)

ws.Range("E" & row).Value = getField(sText, 2)

ws.Range("F" & row).Value = getField(sText, 1)

ws.Range("G" & row).Value = getField(sText, 18)

ws.Range("H" & row).Value = getField(sText, 2)

ws.Range("I" & row).Value = getField(sText, 1)

ws.Range("J" & row).Value = getField(sText, 10)

ws.Range("K" & row).Value = getField(sText, 10)

End if

if left(sText, 2) = "XB" then

ws.Range("A" & row).Value = getField(sText, 4)

ws.Range("B" & row).Value = getField(sText, 10)

ws.Range("C" & row).Value = getField(sText, 18)

ws.Range("D" & row).Value = getField(sText, 2)

ws.Range("E" & row).Value = getField(sText, 1)

ws.Range("F" & row).Value = getField(sText, 1)

ws.Range("G" & row).Value = getField(sText, 19)

ws.Range("H" & row).Value = getField(sText, 11)

End if

Thank you

Do you have to differ between more than those two prefixes? If so, the processing could made even easier by encapsulating the ws.Range stuff into a function, too, and only provide an array with the field lengths.

Title | # Comments | Views | Activity |
---|---|---|---|

modify powershell script to not inherit ntfs permission from parent | 11 | 54 | |

Catch Cancellation error from objShell.Run | 10 | 55 | |

classic asp checkbox uncheck and check | 2 | 39 | |

Macro which automatically sends attachment to Outlook | 14 | 42 |

Join the community of 500,000 technology professionals and ask your questions.

Connect with top rated Experts

**14** Experts available now in Live!