script to extract data from text file and put into excel format

This version will create a XLS file directly.

Option Explicit
'****
'* Read "cTXT" and write "cXLS".
'****
'*
'* Declare Constants
'*
Const cVBS = "tdubb123.vbs"
Const cTXT = "tdubb123.txt"
Const cXLS = "tdubb123.xls"
'*
'* Declare Globals
'*
Dim sDIR
sDIR = WScript.ScriptFullName
sDIR = Left(sDIR,InStrRev(sDIR,"\"))
'*
'* Declare Variables
'*
Dim str1ST
str1ST = ""
Dim arrCOL()
Dim intCOL
intCOL = 1
Dim strCOL
Dim arrDIC()
Dim intDIC
intDIC = 0
Dim strDIC
Dim intKOL
intKOL = 1
Dim arrOTF
Dim intOTF
Dim strOTF
Dim intPOS
Dim strRNG
Dim intROW
intROW = 2
Dim strTXT
Dim strVAL
'*
'* Declare Objects
'*
Dim objDIC
Set objDIC = CreateObject("Scripting.Dictionary")
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(sDIR & cXLS) Then
objFSO.DeleteFile(sDIR & cXLS)
End If
Dim objOTF
Dim objXLA
Set objXLA = CreateObject("Excel.Application")
objXLA.Visible = True
objXLA.Workbooks.Add
objXLA.Worksheets("Sheet1").PageSetup.LeftHeader = cXLS
objXLA.Worksheets("Sheet1").PageSetup.RightHeader = Now
objXLA.Worksheets("Sheet1").PageSetup.PrintTitleRows = "1:1"
objXLA.Worksheets("Sheet1").PageSetup.PrintGridlines = 1
'*
'* Read file
'*
Set objOTF = objFSO.OpenTextFile(sDIR & cTXT,1)
strOTF = objOTF.ReadAll
Set objOTF = Nothing
'*
'* Parse file
'*
arrOTF = Split(strOTF,vbCrLf)
For intOTF = 0 To UBound(arrOTF)
strTXT = arrOTF(intOTF)
If InStr(strTXT,vbTab) > 0 Then strTXT = Replace(strTXT,vbTab,"
")
If InStr(strTXT,Chr(34)) > 0 Then
MsgBox "Data contains quotation marks!",vbCritical,cVBS
Exit For
End If
intPOS = InStr(strTXT,": ")
If intPOS > 0 Then
'*
'* Split each valid line into name/value pair
'*
strDIC = Trim(Left(strTXT,intPOS-1))
strVAL = Trim(Mid(strTXT,intPOS+2))
'*
'* Identify first column name
'*
If str1ST = strDIC Then intROW = intROW + 1
If str1ST = "" Then str1ST = strDIC
'*
'* Test dictionary
'*
If Not objDIC.Exists(strDIC) Then
'*
'* Build dictionary of column names
'*
intDIC = intDIC + 1
objDIC.Add strDIC, intDIC
ReDim Preserve arrDIC(intDIC)
arrDIC(intDIC) = strDIC
'*
'* Write column header
'*
objXLA.Cells(1,intCOL).Value = strDIC
objXLA.Cells(intROW,intCOL).Value = strVAL
If intKOL < intCOL Then intKOL = intCOL
intCOL = intCOL + 1
Else
'*
'* Write column detail
'*
intCOL = CInt(objDIC.Item(strDIC))
objXLA.Cells(intROW,intCOL).Value = strVAL
End If
End If
Next
'*
'* Quit Excel
'*
strRNG = "A1:" & Chr(64+intKOL) & "1"
objXLA.Range(strRNG).Select
objXLA.Selection.Font.Bold = True
strRNG = "A1:" & Chr(64+intKOL) & intROW
objXLA.Range(strRNG).Select
objXLA.Selection.Font.Name = "Arial"
objXLA.Selection.Font.Size = 9
objXLA.Cells.EntireColumn.AutoFit
objXLA.ActiveWorkbook.SaveAs(sDIR & cXLS)
objXLA.Quit
'*
'* Destroy Objects
'*
Set objDIC = Nothing
Set objFSO = Nothing
Set objXLA = Nothing
'*
'* Finish Message
'*
MsgBox intROW & " rows.",vbInformation,cVBS

Both of my scripts (TXT to CSV and TXT to XLS) will handle it without
changes since that's the delimeter (": ") that I programmed them for.

However, MS-Excel shows the "accountExpires" value as 1.28577E+17.

Maybe this script can help you out a little bit....... it fills out an excel
spreadsheet with all the values you have in your text file...

Const ForReading = 1

Set objDict = CreateObject("Scripting.Dictionary")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("C:\test.txt",ForReading)

Do Until objTextFile.AtEndOfStream
strLine = objTextFile.ReadLine
If Instr(strLine,":") Then
arrSplit = Split(strLine,":")
strField = arrSplit(0)
strValue = arrSplit(1)
If Not objDict.Exists(strField) Then
objDict.Add strField,strValue
Else
objDict.Item(strField) = objDict.Item(strField) & "||" & strValue
End If
End If
Loop

objTextFile.Close

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add

intColumn = 1

For Each strItem In objDict.Keys
objExcel.Cells(1,intColumn) = strItem
intColumn = intColumn + 1
Next

intColumn = 1

For Each strItem In objDict.Items
arrValues = Split(strItem,"||")
intRow = 1
For Each strValue In arrValues
intRow = intRow + 1
objExcel.Cells(intRow,intColumn) = strValue
Next
intColumn = intColumn + 1
Next

It worked for me, but I don't know if it did the way you want it to....

Good luck!

Why use complex vb scripting and not something simple like intelliget
script. Your script would look like:

userVariables = computerName, logFile, eventCode;

{startCriteria = IsSubstring("Category",Line(0));
computerName = Field(Line(1),2);
logFile = Field(Line(2),2);
eventCode = Field(Line(3),2);
output = Concat(computerName, ",", logFile, "," eventCode);
}

[awonder01]

Hi,

Could you show me the script? thanks a lot!

i meant a script that i can use at a doc prompt...

[EINSTEIN_007]

I know a script to extract data form txt file in bat

@echo off > new.txt
for %%T in (*.txt) do find "MACHINING CYCLE TIME" < %%T >> new.txt

And for data extraction, try using the product intelliget that is available at http://www.mountonetech.com/products.asp.