rename "txt files from Excel macro

[teoiva]

Hi from Bulgaria,
Please HELP
I'm new in VBA and I need macro that will rename txt files.
What I have is text files stored in a folder, let's say:
D\AIR\:
Each file is named as follows

AIR_2054.TXT
AIR_2055.TXT
AIR_2056.TXT ect...

What I need is macro that will read specific line form D\AIR\:"AIR_*.TXT" files and rename it ,depends on it contents

The Text files are different type , let's say 5 type


TYPE 1 check only in line 2 - /most common /
if mid(line2,13,5)="AGENT" then rename file as BIR_2054.TXT /change first string of file name from A to B/
[B]
[B]TYPE 2 check only in line 3
if mid(line3,2,3)="EMD" then rename file as EIR_2055.TXT /change first string of file name from A to E/

TYPE 3 check only in line 2
if mid(line2,18,3)="MCO"then rename file as MIR_2055.TXT /change first string of file name from A to M/

TYPE 4 check only in line 1
if mid(line1,1,16)="AUTOMATED REFUND"then rename file as RIR_2055.TXT /change first string of file name from A to R/

TYPE 5 -
NOTHING MATCH TO TYPE 1,2,3,4 THEN rename file as xIR_2055.TXT /change first string of file name from A to x/

Notes
*If one of the file contain data of ONE TYPE it is not possible to contain other TYPES*
*Some of the types start from 2-nd line /first line is blank/


I hope that you understand me:-)
Thanks in advance
Teodora

[taps]

Hi Teodora,

Welcome in Excel Forum.

Please let me clear few confusion.
As you have mentioned in notes that "Some of the types start from 2nd line /first line is blank"--
then what happen for Type 2 (say)- should we start finding "EMD" in line 4? (same confusion for remaining types).

regards
taps

[JBeaucaire]

Untested, this seems to be sound for what you're trying to do. This will create a DONE folder inside your AIR folder and renamed files will go in there. This is to avoid an infinite loop of TXT files by the name changing.

Option Explicit

Sub RenameTXTFiles()
Dim fPATH As String, fPATHdone As String, fNAME As String, LineText As String

fPATH = "C:\AIR\"               'remember the final \ in this string, original files are here
fPATHdone = "C:\AIR\Done\"      'remember the final \ in this string, renamed files go here

On Error Resume Next
    MkDir fPATHdone
On Error GoTo 0

fNAME = Dir(fPATH & "*.txt")    'get the first random filename

Do While Len(fNAME) > 0

    Open fPATH & fNAME For Input As #1  'open found file for reading

    Line Input #1, LineText             'evaluating line 1
    If Mid(LineText, 1, 16) = "AUTOMATED REFUND" Then
        Close #1
        Name fPATH And fNAME As fPATHdone And Replace(fNAME, "AIR", "RIR")
        GoTo Next1
    Else
        Line Input #1, LineText         'now evaluating line 2
        If Mid(LineText, 13, 5) = "AGENT" Then
            Close #1
            Name fPATH And fNAME As fPATHdone And Replace(fNAME, "AIR", "BIR")
            GoTo Next1
        ElseIf Mid(LineText, 18, 3) = "MCI" Then
            Close #1
            Name fPATH And fNAME As fPATHdone And Replace(fNAME, "AIR", "MIR")
            GoTo Next1
        Else
            Line Input #1, LineText         'now evaluating line 3
            If Mid(LineText, 2, 3) = "EMD" Then
                Close #1
                Name fPATH And fNAME As fPATHdone And Replace(fNAME, "AIR", "EIR")
                GoTo Next1
            End If
        End If
    End If

    'if we reach this point, no matches
    Close #1
    Name fPATH And fNAME As fPATHdone And Replace(fNAME, "AIR", "xIR")
Next1:
    fNAME = Dir
Loop

End Sub

[teoiva]

Thank you very match!!!!
I mede some changes that match my needs and code works perfect
Regards Teddy

[JBeaucaire]

As I expected you would. Glad to hear it's working for you.

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.