Taking specific line out of a text file and putting into excel.

[gjsala]

I'm really new at taking items out of a text file and putting it into excel. I would like to look through text files, sometime 100 or more, in a specific folder and look for the word "Phone" in each file. When this word is found which is located in column two of the text file, I would like to place the whole row which the word is accociated from the text file into an excel row. In the following code I gather all text files from a specific folder and parse it out into excel. The problem is some of the files are 2 MB or greater in size and excel has a limit of how many rows are in a spreadsheet. Most of the files are left out of the worksheet because of this limitation. Any help would be appreciated. Thanks!

Function PickFolder(strStartDir As Variant) As String
    'Selecting a folder to gather the text files and put into one excel spreadsheet.
    Dim SA As Object, F As Object
    Set SA = CreateObject("Shell.application")
    Set F = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
    If (Not F Is Nothing) Then
        PickFolder = F.Items.Item.path
    End If
    Set F = Nothing
    Set SA = Nothing
End Function
Sub V11_Folder()
    Dim lrow As Long
    Dim Hdrs As Long
    Dim NumCols As Long
    Dim ffc As Long
    Dim i As Long
    Dim R As Integer
    Dim WBn As String
    Dim rng As Range
    Dim WB As Workbook
    Dim WBr As Range
    Dim WBlstrw As Long
    Dim CurWkb As Workbook
    Dim CurWks As Worksheet
    Dim CurWksLrow As Long
    Dim strStartDir As String
    Dim UserFile As String
    Dim Sht As Worksheet
    Dim peach As String
     
    On Error Resume Next

    UserFile = PickFolder(strStartDir)
    If UserFile = "" Then
        MsgBox "Canceled"
        Exit Sub
    End If
    
    Set CurWkb = Workbooks.Add

    'CurWks will always refer to the Summary worksheet you are creating
    Set CurWks = CurWkb.Worksheets(1)

    Application.ScreenUpdating = False

    'Clear out the Summary worksheet
    With CurWks
        .Activate
        .UsedRange.Delete
    End With

    lrow = 1
    Hdrs = 1
    With Application.FileSearch
        .SearchSubFolders = True
        .NewSearch
        '.FileName = ".xls"
        .FileName = ".txt"
        .LookIn = UserFile
        .FileType = msoFileTypeExcelWorkbooks
        .Execute

        ffc = .FoundFiles.count

        For i = 1 To ffc
        
            'WB will always refer to the source Workbook that
            'you are interrogating at the time
            Set WB = Application.Workbooks.Open(FileName:=.FoundFiles(i))
            If i = 1 Then
                
                NumCols = WB.Sheets(1).UsedRange.Column - 1 + _
                                WB.Sheets(1).UsedRange.Columns.count
                CurWks.Cells(Hdrs, "A").Resize(1, NumCols).Value = _
                WB.Worksheets(1).Range("A1").Resize(1, NumCols).Value
                          
            End If

            Application.StatusBar = "Currently Processing file " & i & " of " & ffc

            WBn = WB.Name
            WBlstrw = WB.Sheets(1).Cells(Rows.count, "A").End(xlUp).row

            'Copy the data across
            CurWks.Cells(lrow + 1, "A").Resize(WBlstrw - Hdrs, NumCols).Value = _
            WB.Worksheets(1).Range("A2").Resize(WBlstrw - Hdrs, NumCols).Value
            'Put the filename in the first Col as an index value
            lrow = lrow + (WBlstrw - Hdrs)
            WB.Close savechanges:=False
        Next
    End With

    Set WB = Nothing
    Set CurWks = Nothing
    Set CurWkb = Nothing
    Call V11_Log
End Sub
Sub V11_Log()
Dim R As Long
Dim numRows As Integer
Dim myRange As Range
Dim numR As Integer
Dim wsThis As Worksheet, wsNew As Worksheet
Dim Filter As String, title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim FileName As Variant
'This code will allow you to select how many files you want to open and then parse them out automatically.
Application.ScreenUpdating = False
' File filters
Filter = "Excel Files (*.xls),*.xls," & _
        "Text Files (*.txt),*.txt," & _
        "All Files (*.*),*.*"
'   Default filter to *.*
    FilterIndex = 3
' Set Dialog Caption
title = "Select File(s) to Open"
' Select Start Drive & Path
ChDrive ("C")
ChDir ("C:\test")
With Application
    ' Set File Name Array to selected Files (allow multiple)
    FileName = .GetOpenFilename(Filter, FilterIndex, title, , True)
    ' Reset Start Drive/Path
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Not IsArray(FileName) Then
    MsgBox "No file was selected."
    Exit Sub
End If
' Open Files
For i = LBound(FileName) To UBound(FileName)
    Workbooks.Open FileName(i)
    Set wsThis = ActiveSheet
    Set myRange = wsThis.Range("A1:A5000")
    numR = myRange.count
        For R = 1 To numR + 1
            If (wsThis.Cells(R, 2)) <> "Phone" Then
                    Rows(R).Select
                    Selection.Delete Shift:=xlUp
                    R = R - 1
            End If
            If (wsThis.Cells(R + 1, 2)) = "" Then
                    Exit For
          End If
        Next R
        Cells.Select
        Cells.EntireColumn.AutoFit
        Range("A1").Select
        If Cells(1, 1) = "" Then
            ActiveWindow.Close False
        End If
Next i
Application.ScreenUpdating = True
End Sub

 

[Andrzejek]

What I did some time ago is (in VB, but it should work for you, too):

filFile is a FileListBox with all text files that you want to search or you can go down the list of text files any other way.

Private Sub cmdSearch_Click()
Dim strLine As String
Dim f As Integer

Me.MousePointer = vbHourglass

For f = 0 To filFile.ListCount - 1
    filFile.ListIndex = f
    Open filFile.Path & "\" & filFile.List(f) For Input As #1
    Do While Not EOF(1)
        Line Input #1, strLine
        If InStr(1, strLine, "Phone") > 0 Then
            [green]'Write strLine into Excel file[/green]
        End If
    Loop
    Close #1
Next f

Me.MousePointer = vbDefault

End Sub

Have fun.

---- Andy

 

[SkipVought]

Hi,

If all the text files have the same data in the first record, you could use a TEXT ODBC query. It's kinda klunky, but, guess what -- NO VBA code required, just an SQL LIKE criteria.

Skip,

_[red][/red]

 

[gjsala]

Thank you Andy for the quick response. Could you guide me where I should insert this code into mine above? I tried to replace my Function, but I got a bunch of errors. Also in VBA the me.mousepointer gave me an error, could I just use Mousepointer instead? Thanks again.

 

[CautionMP]

gjsala,
I agree with SkipVought that queries are the way to go, but if your talkin' possibly 100's of files you will want to stick with code.
You can create a [tt]ADODB.Connection/Recordset[/tt] object in your Excel macro that points to a text file and then use it to populate your worksheeet.

A good place to start would be: MSDN : Much ADO About Text Files

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT+08:00) Singapore

 

[Andrzejek]

I agree with gjsala who agrees with SkipVought - queries are the way to go, but if you really want to use the code I gave you, it will not fit into your code, it can stand by itself, pretty much.

You just need to find the best way to step thru your text files (you may want to use FSO - File Scripting Object, which I hate, but that's personal preference), one by one, I do it with:

For f = 0 To filFile.ListCount - 1

and the logic inside will give you the line of text from your text file with "Phone" in it.

And if the line with Me.MousePointer gives you an error - forget about it, it is juzt to change pointer to an hourglass and back, but you don't need it.


Have fun.

---- Andy

 

[gjsala]

Thanks for all of the responses! I would like to read the text files in vba but when I use Andy's code I keep getting an "Object Required" and the line of code that it highlights is:

For f = 0 To filFile.ListCount - 1

I'm sure I'm missing something very small.

Thanks.

 

[SkipVought]

You need to post all the code that leads up to the statement that fails.

Skip,

_[red][/red]

 

[Andrzejek]

This is a VB 6 code and on my Form I used a VB control called FileListBox named filFile

This is a control I use to display all files (or filter and display only *.txt files) in it. That's how I step thru my text files.

I don't know if you have the same functionality in VBA, that's why I said: "You just need to find the best way to step thru your text files"

Have fun.

---- Andy

 

[gjsala]

Skip,
Here is the code leading up the the "Object Required"

Private Sub cmdSearch_Click()
Dim strLine As String
Dim f As Integer
'UserFile = PickFolder(strStartDir)
'Me.MousePointer = vbHourglass
For f = 0 To filFile.ListCount - 1
    filFile.ListIndex = f
    'Open filFile.path & "\" & filFile.List(f) For Input As #1
    Open filFile.path & "C:\Database" & filFile.List(f) For Input As #1
    'J:\GJSALA\Public\Pal Reports\v11\Test
    Do While Not EOF(1)
        Line Input #1, strLine
        If InStr(1, strLine, "Error") > 0 Then
            'Write strLine into Excel file
        End If
    Loop
    Close #1
Next f

Thanks Andy for the response.

 

[SkipVought]

filFile is never SET to an object.

Skip,

_[red][/red]

 

[SkipVought]

That should have been a question.

Was filFile ever set to an object?

Skip,

_[red][/red]

 

[gjsala]

Skip,

I don't think filFile was set to an object. Should it?