VBA Rename Multiple .txt Files

**cdowney** · 06-30-2013, 10:05 AM

I have went through all of the post on this in this Forum and many others and have had no luck. Here is the only thing that I could find that comes close to working for me. But I would have to create code to have this work. http://www.glynnconsulting.co.uk/RenameFiles.zip The problem I'm having is when there are semi-duplicates. For example if I have
id_4701_01.txt
id_4701_02.txt ***This is the format that all of my .txt files are in. And there may be more than one that has this happen.

*the end result for all files needs to be id_4701.txt and in the case were there may be two I want to just rename the first one that the VBA code finds

All I'm trying to do is have VBA Code rename all files in a folder to get rid of the _01 (or other _0X "x" being another number) Any help would be greatly appreciated.
**Note: The big picture is that I am automating alot of tasks that we currently do and have them run automatically over night and be done when we get in.

**AlphaFrog** · 06-30-2013, 12:08 PM

Are all the file names with this exact naming convention where the zeros are any numeric digit?
id_0000_00.txt

What do you want to do with the other files e.g.
id_4701_01.txt
id_4701_02.txt
Remane id_4701_01.txt as id_4701.txt, and then what to do with id_4701_02.txt? Delete it?

Are there any other files in the folder that you do not want to rename?

**cdowney** · 06-30-2013, 02:21 PM

Yes all files are with the exact naming convention. I need it to skip the 2nd one. Sometimes there may be a few pdf files in the folder I dont' need to do anything with these.

**p24leclerc** · 06-30-2013, 12:10 PM

try the following macro:

Public Sub Ren_Files()
Dim c00 As String, c01 As String, F_Name As String
 c00 = "c:\Data2" 'Here you can change the folder to look at
c01 = Dir(c00 & "\") 'Get first file name
Do While c01 <> ""
  If InStr(4, c01, "_", vbTextCompare) <> 0 And _
    F_Name <> c00 & "\" & Left(c01, InStr(4, c01, "_", vbTextCompare) - 1) & ".txt" Then
    F_Name = c00 & "\" & Left(c01, InStr(4, c01, "_", vbTextCompare) - 1) & ".txt"
    Name c00 & "\" & c01 As F_Name
  End If
  c01 = Dir
Loop
MsgBox "COMPLETED", vbOKOnly, "RENAMING FILES"
End Sub

**cdowney** · 06-30-2013, 02:23 PM

I get a Run-time erro '5'
Invalid procedure call or argument

when I run this (the code that was posted by p24leclerc)

**AlphaFrog** · 06-30-2013, 03:34 PM

Sub Rename_ID_Files()
    Const strPath As String = "C:\Test\"    'File Folder
    Dim strFile As String, strNewFile As String, i As Long
    
    With CreateObject("Scripting.Dictionary")
        strFile = Dir$(strPath & "id_????.txt")
        Do While Len(strFile)
            .Item(strFile) = 1
            strFile = Dir$
        Loop
        strFile = Dir$(strPath & "id_????_??.txt")
        Do While Len(strFile)
            strNewFile = Left(strFile, 7) & ".txt"
            If Not .Exists(strNewFile) Then
                Name strPath & strFile As strPath & strNewFile
                .Item(strNewFile) = 1
                i = i + 1
            End If
            strFile = Dir$
        Loop
        MsgBox i & " files renamed. ", vbInformation, "Rename ID Files"
    End With
    
End Sub