Convert txt file to excel in vbscript
Solution 1
I'd use a regular expression to transform the data into CSV format:
Set fso = CreateObject("Scripting.FileSystemObject")
Set inFile = fso.OpenTextFile("C:\path\to\input.txt")
Set outFile = fso.OpenTextFile("C:\path\to\output.csv", 2, True)
Set re = New RegExp
re.Pattern = "^week: (\d+) seconds: (\d+\.\d+) x: (\d+\.\d+) " & _
"y: (-\d+\.\d+) heading: (\d+)$"
re.IgnoreCase = True
outFile.WriteLine "Week,Seconds,X,Y,Heading"
Do Until inFile.AtEndOfStream
For Each m In re.Execute(inFile.ReadLine)
outFile.WriteLine m.Submatches(0) & "," & m.Submatches(1) & "," & _
m.Submatches(2) & "," & m.Submatches(3) & "," & m.Submatches(4)
Next
Loop
inFile.Close
outFile.Close
Then you can open the CSV file with Excel and save it as a workbook.
Solution 2
I'll throw out another solution. Just use Excel's TextToColumns()
function. Tell it to use Space
(8th argument = True
) as a delimiter and to Treat consecutive delimiters as one
(4th argument = True
).
Const xlDelimited = 1
Const xlDoubleQuote = 1
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Open "c:\path\to\text.txt"
With objExcel.ActiveSheet
.Columns("A:A").TextToColumns .Range("A1"), xlDelimited, xlDoubleQuote, True, , , , True
End With
Or, in long form:
With objExcel.ActiveSheet
.Columns("A:A").TextToColumns _
.Range("A1"), _ ' Destination
xlDelimited, _ ' Data Type
xlDoubleQuote, _ ' Text Qualifier
True, _ ' Consecutive Delimiters?
, _ ' Use Tab for Delimiter?
, _ ' Use Semicolon for Delimiter?
, _ ' Use Comma for Delimiter?
True ' Use Space for Delimiter?
End With
That will get your data into proper columns. Then just delete the "label" columns:
.Range("A:A,C:C,E:E,G:G,I:I").Delete
and save it as a CSV
.
Solution 3
A faster way: convert the file to csv. Since your source is fixed width the easiest way is to just copy the bits you need to a new line.
sep = ";" 'or , (depends on your language settings)'
header = "week" & sep & "seconds" & sep
line = "WEEK: 1799 SECONDS: 251731.358 X:32.896391 Y:-117.200281 Heading: 178"
csvLine = mid(line,7,4) & sep & mid(line,22,10) & sep 'etc..'
'write to your csv file, here I only echo to the screen
Wscript.echo header
Wscript.echo csvLine
'week;seconds;
'1799;251731.358;
Using this method is faster end you don't need Excel installed on the pc
Solution 4
From the comments, I think it might be easier to skip VBA, change the .txt file extension into .csv. Then, when you open this in Excel, you'll get a column with all of your data.
Along the top, under the "Data" tab, you'll see "Text to Columns". Highlight column A, choose "Text to Columns", then choose "Delimited", and hit "Next", then choose "Space". You'll see a preview of how the data will be split up below it. If that looks good, you can click "Finish" to overwrite Col. A with the new split up data, or click "Next" to choose a specific cell to start in.
That should get you pretty far, and it may not be perfect, so let me know what it looks like after this (or if you have any questions).
user3404290
Updated on June 14, 2022Comments
-
user3404290 almost 2 years
I am trying to convert a text file into an excel sheet. This is what the format looks like.
I have tried writing a script but currently all it does is overwrites my current text file adding my column headers. It does not add any of the data from my text file. Could anyone help me understand what I am doing wrong.
Set objExcel = CreateObject("Excel.Application") objExcel.Visible = True strInput=InputBox("Enter name of File in C:\Users\spencerr\Desktop\MyProject\bin\") 'ask user for file name Set wb = objExcel.Workbooks.Open("C:\Users\bob\Desktop\MyProject\bin\" & strInput) 'Delete labels in log For i = 1 To 5 Set objRange = objExcel.Cells(1, i).EntireColumn objRange.Delete Next Set activeCell = objExcel.Cells(1, 2) Dim intVal Dim comVal Dim primeRow Dim largestRow Dim largestDec Dim row primeRow = 0 'filter out one measurement per second Do Until IsEmpty(activeCell) primeRow = primeRow + 1 'get base integer of first value by chopping off decimal intVal = Fix(activeCell.Value) comVal = intVal 'get all consecutive rows that have same base integer Do While intVal = comVal row = activeCell.Row Set activeCell = objExcel.Cells((row + 1), 2) comVal = Fix(activeCell.Value) Loop 'highest row number that contains the base integer largestRow = row 'delete all the rows up to the largest row j = primeRow Do While j < largestRow Set deleteRow = objExcel.Cells(primeRow, 2).EntireRow deleteRow.Delete j = j + 1 Loop 'compare the value right below the exact second and the value right above to see 'which is closer to the exact second Set activeCell = objExcel.Cells(primeRow, 2) largestDec = activeCell.Value Set activeCell = objExcel.Cells((primeRow + 1), 2) comVal = activeCell.Value if (((intVal + 1) - largestDec) > (comVal - (intVal + 1))) Then objExcel.Cells(primeRow, 2).EntireRow.Delete End If Loop 'round all the seconds that are left to the nearesr second Set activeCell = objExcel.Cells(1, 2) Do Until IsEmpty(ActiveCell) row = activeCell.row objExcel.Cells(row, 2) = Round(activeCell.Value) Set activeCell = objExcel.Cells(row + 1, 2) Loop 'add labels for KML conversion objExcel.Cells(1,1).EntireRow.Insert objExcel.Cells(1, 2).Value = "Description" objExcel.Cells(1, 3).Value = "Latitude" objExcel.Cells(1, 4). Value = "Longitude" wb.Save wb.Close objExcel.Quit