CODEWITHSUNDEEP
excelvbscript
user3404290
user3404290

Reputation: 45

Convert txt file to excel in vbscript

I am trying to convert a text file into an excel sheet. This is what the format looks like.

Data

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

Upvotes: 2

Views: 15711

Answers (4)

Bond
Bond

Reputation: 16311

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.

Upvotes: 2

Ansgar Wiechers
Ansgar Wiechers

Reputation: 200293

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.

Upvotes: 3

peter
peter

Reputation: 42192

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

Upvotes: 1

BruceWayne
BruceWayne

Reputation: 23283

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).

Upvotes: 1

Related Questions