Solved

VBA - Read "txt" files in a folder and delete first line according to a criteria

Posted on 2014-11-04
14
469 Views
Last Modified: 2014-11-13
Hi Experts!

I am a beginner in VBA programming so I would like to ask how to achieve the following:

For each file in a folder [“txt” files only]
      While file has lines
           If the last 4 characters of the line = “.exl” then
                 Delete line
          End if
     End While
 End For each

Open in new window


Thank you very much in advance.
Antonio
0
Comment
Question by:Duke001
14 Comments
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
Please try this:
Public Sub Q_28550315()
    Dim strFile As String
    Const cPath As String = "C:\users\aikimark\downloads\"
    Dim strLine As String
    Dim colLines As Collection
    Dim vItem As Variant
    Dim intFN As Integer
    strFile = Dir(cPath & "*.txt")
    Do Until Len(strFile) = 0
        Set colLines = Nothing
        Set colLines = New Collection
        intFN = FreeFile
        Open cPath & strFile For Input As #intFN
        Do Until EOF(intFN)
            Input #intFN, strLine
            If Right(strLine, 4) = ".exl" Then
            Else
                colLines.Add strLine
            End If
        Loop
        Close intFN
        Open cPath & strFile For Output As #intFN
        For Each vItem In colLines
            Print #intFN, vItem
        Next
        Close intFN
        strFile = Dir
    Loop
End Sub

Open in new window

0
 
LVL 20

Expert Comment

by:ElrondCT
Comment Utility
Assuming you want to do this in Excel (and trusting that there aren't any tabs in the file that would cause the input line to get broken up into multiple cells):
Sub ChangeAllText()
' Created for EE question http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_28550315.html
Dim fldr As FileDialog
Dim sFolder As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then
        Set fldr = Nothing
        Return
    End If
    sFolder = .SelectedItems(1)
End With
Set fldr = Nothing
Dim CurFile As String
Dim CurRow As Integer
Dim RowsDeleted As Boolean
CurFile = Dir(sFolder & "\*.txt")
Do While CurFile <> ""
    Workbooks.OpenText Filename:=(sFolder & "\" & CurFile), Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2))
    ActiveCell.SpecialCells(xlLastCell).Select
    RowEnd = Selection.Row
    RowsDeleted = False
    For CurRow = RowEnd To 1 Step -1
        If Right(Cells(CurRow, 1), 4) = ".exl" Then
            Rows(CurRow).Delete Shift:=xlUp
            RowsDeleted = True
        End If
    Next
    If RowsDeleted Then
        ActiveWorkbook.Save
    End If
    ActiveWorkbook.Close Savechanges:=False
    CurFile = Dir
Loop

End Sub

Open in new window

0
 

Author Comment

by:Duke001
Comment Utility
Hi aikimark!

The code works perfectly but now I've realized that one of the files becomes empty (no lines as the only one in it was the one with ".exl").
Would you kindly guide me how to copy a content of one of the files and past it on the empty one?

Many thanks
Antonio
0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
Can you give me an example of what you want?
Will the replacement be a single line or something more complex?
0
 
LVL 18

Expert Comment

by:krishnakrkc
Comment Utility
A different method but with an exception. It will remove all lines which is having the criteria.

Option Explicit

Sub kTest()
    
    Dim Fso         As Object
    Dim f, d, k, FN As String
    Dim tfp         As String
    
    tfp = "C:\Test\" '<< adjust to suit.
    Const Crit          As String = ".exl"
    
    Set Fso = CreateObject("scripting.filesystemobject")
    
    FN = Dir(tfp & "*.txt")
    
    Do While Len(FN)
        Set f = Fso.OpenTextFile(tfp & FN, 1)
        d = Split(f.ReadAll, vbLf)
        f.Close
        k = Filter(d, Crit, False)
        Set f = Fso.OpenTextFile(tfp & FN, 2)
        f.Write Join(k, vbLf)
        f.Close
        FN = Dir()
    Loop
    
End Sub

Open in new window


Kris
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:Duke001
Comment Utility
Hi aikimark!

After running the code you've just sent one of the files becomes empty (no lines) and for that one I would like to paste the following line and keep the same name.

10      Session      2010      2010

Many thanks
Antonio
0
 
LVL 45

Accepted Solution

by:
aikimark earned 500 total points
Comment Utility
Since it is only a single line, then this seems to be a simple implementation.
Public Sub Q_28550315()
    Dim strFile As String
    Const cPath As String = "C:\users\aikimark\downloads\"
    Const cDefault As String = "10      Session      2010      2010"
    Dim strLine As String
    Dim colLines As Collection
    Dim vItem As Variant
    Dim intFN As Integer
    strFile = Dir(cPath & "*.txt")
    Do Until Len(strFile) = 0
        Set colLines = Nothing
        Set colLines = New Collection
        intFN = FreeFile
        Open cPath & strFile For Input As #intFN
        Do Until EOF(intFN)
            Input #intFN, strLine
            If Right(strLine, 4) = ".exl" Then
            Else
                colLines.Add strLine
            End If
        Loop
        Close intFN
        Open cPath & strFile For Output As #intFN
        If colLInes.Count = 0 Then
            Print #intFN, cDefault
        Else
            For Each vItem In colLines
                Print #intFN, vItem
            Next
        End If
        Close intFN
        strFile = Dir
    Loop
End Sub

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
@Antonio

In an effort to improve the quality of my solutions, please let me know what I could have done to get an A (excellent) grade instead of a B (good) grade.
0
 

Author Comment

by:Duke001
Comment Utility
@aikimark

I'm sorry as I understood that the lack of comments and explanations would imply the grade "B" even though I thing personally that you deserved a grade "A".
Please let me know if I am able to change the grade from "B" to "A" and I'll do it without hesitations.

Thanks again for the clear "code" and definitely I will contact you in the future.

Regards,
Antonio
0
 

Author Comment

by:Duke001
Comment Utility
@aikimark

I have realised that when the "txt" file contains "," in a line then the saved file will break after each "," creating a new line.
Would you please let me know how to avoid that?
Thanks
0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
Please post the file
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now