Extracting certain data from a text file to Excel using VBA or a Macro?

[IKHAN]

Hello,

I am trying to extract certain data from a text file(Windowsupdate1) into an Excel spreadsheet. I'm using MS Office 2010 . I saved my files as TEXT formatted files and now I need to pull information from the text files.Here is a list of the information I need to extract from the text file:
Title = (the data immediately after the Title =) and must be in 2nd column in spreadsheet
Date associated with "Title = " row and must be in 1st column in spreadsheet
extract KBnumber from "Title =" row and must be in 3rd column in spreadsheet
sort by dates column

Attached sample txt file and required output excel file

Really appreciate your help!!!!

 

[Deepak]

check this.

Option Explicit

Sub importTXT()
Dim r As Range, myfile As Variant
Dim qt As QueryTable, i As Integer
Dim del As Range

'where myfile needs to select manually
myfile = Application.GetOpenFilename("All Files (*.*), **.*", _
, "Select TXT file", , False)
If myfile = False Then Exit Sub

'elseif its fixed
'myfile = "D:\windowsupdate1.txt"

Application.ScreenUpdating = False

With ActiveSheet
.Range("A1").CurrentRegion.Cells.Clear
With .QueryTables.Add(Connection:="TEXT;" & myfile, Destination:=.Range("$A$1"))
        .Name = "windowsupdate1"
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileTabDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
'delete query tables if found any.
    For Each qt In ActiveSheet.QueryTables
        qt.Delete
    Next qt
'Delete the Data Connections
If .Parent.Connections.Count > 0 Then
    For i = 1 To .Parent.Connections.Count
        .Parent.Connections.Item(i).Delete
    Next i
End If

For Each r In .Range("F1:F" & .UsedRange.Rows.Count)
    If InStr(r, "Title = ") > 0 Then
        r.Offset(, 1) = Mid(r.Value, InStr(r, "Title = ") + 8, InStrRev(r.Value, " (KB"))
        r.Offset(, 2) = Mid(r.Value, InStrRev(r.Value, " (KB") + 2, Len(r.Value) - InStrRev(r.Value, " (KB") - 2)
    Else
        If del Is Nothing Then
            Set del = r
        Else
            Set del = Union(del, r)
        End If
    End If
Next
del.EntireRow.Delete
.Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Sort Key1:=.[A1], Order1:=xlAscending
.Cells.Columns.AutoFit
.Columns("B:F").Delete
End With
Application.ScreenUpdating = False
End Sub

 

[IKHAN]

check this.

Option Explicit

Sub importTXT()
Dim r As Range, myfile As Variant
Dim qt As QueryTable, i As Integer
Dim del As Range

'where myfile needs to select manually
myfile = Application.GetOpenFilename("All Files (*.*), **.*", _
, "Select TXT file", , False)
If myfile = False Then Exit Sub

'elseif its fixed
'myfile = "D:\windowsupdate1.txt"

Application.ScreenUpdating = False

With ActiveSheet
.Range("A1").CurrentRegion.Cells.Clear
With .QueryTables.Add(Connection:="TEXT;" & myfile, Destination:=.Range("$A$1"))
        .Name = "windowsupdate1"
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileTabDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
'delete query tables if found any.
    For Each qt In ActiveSheet.QueryTables
        qt.Delete
    Next qt
'Delete the Data Connections
If .Parent.Connections.Count > 0 Then
    For i = 1 To .Parent.Connections.Count
        .Parent.Connections.Item(i).Delete
    Next i
End If

For Each r In .Range("F1:F" & .UsedRange.Rows.Count)
    If InStr(r, "Title = ") > 0 Then
        r.Offset(, 1) = Mid(r.Value, InStr(r, "Title = ") + 8, InStrRev(r.Value, " (KB"))
        r.Offset(, 2) = Mid(r.Value, InStrRev(r.Value, " (KB") + 2, Len(r.Value) - InStrRev(r.Value, " (KB") - 2)
    Else
        If del Is Nothing Then
            Set del = r
        Else
            Set del = Union(del, r)
        End If
    End If
Next
del.EntireRow.Delete
.Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Sort Key1:=.[A1], Order1:=xlAscending
.Cells.Columns.AutoFit
.Columns("B:F").Delete
End With
Application.ScreenUpdating = False
End Sub

Hello,

I am trying to extract certain data from a text file(Windowsupdate1) into an Excel spreadsheet. I'm using MS Office 2010 . I saved my files as TEXT formatted files and now I need to pull information from the text files.Here is a list of the information I need to extract from the text file:
Title = (the data immediately after the Title =) and must be in 2nd column in spreadsheet
Date associated with "Title = " row and must be in 1st column in spreadsheet
extract KBnumber from "Title =" row and must be in 3rd column in spreadsheet
sort by dates column

Attached sample txt file and required output excel file

Really appreciate your help!!!!

Thanks..It works

 

[shrivallabha]

Text files reading is interesting task. Here's one more approach.

Public Sub ImportTextFile()
Dim strSecond As String
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strFile: strFile = Application.GetOpenFilename("All Files (*.*), **.*", , "Select TXT file", False) '\\Get file
If strFile <> False Then
  Dim objTxt As Object: Set objTxt = objFSO.OpenTextFile(strFile, 1) '\\ start reading file
  Dim varSource As Variant: varSource = Filter(Application.Transpose(Application.Transpose( _
  Split(objTxt.readall, vbCrLf))), "Title = ", True, vbTextCompare) '\\ find entries of interest
  For i = LBound(varSource) To UBound(varSource) '\\ process found matches
  Cells(i + 1, 1).Value = Split(varSource(i), vbTab)(0)
  strSecond = Split(varSource(i), "Title =")(1)
  Cells(i + 1, 2).Value = Trim(strSecond)
  Cells(i + 1, 3).Value = Replace(Mid(strSecond, InStr(strSecond, "(") + 1, 99), ")", "")
  Next
  objTxt.Close '\\ close stream
Else
  MsgBox "No file selected!", vbExclamation
End If
Set objFSO = Nothing: objTxt = Nothing 'release objects
End Sub