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

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
Duke001Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

aikimarkCommented:
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
ElrondCTCommented:
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
Duke001Author Commented:
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
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

aikimarkCommented:
Can you give me an example of what you want?
Will the replacement be a single line or something more complex?
0
krishnakrkcCommented:
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
Duke001Author Commented:
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
aikimarkCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
aikimarkCommented:
@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
Duke001Author Commented:
@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
Duke001Author Commented:
@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
aikimarkCommented:
Please post the file
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.