Excel VBA to rename files in a folder?

taigovinda

Well-known Member
Joined
Mar 28, 2007
Messages
2,639
I have a bunch of files that I make every day. Then I copy them to an archive folder and re-name the ones that are still in my current folder.

For instance, tomorrow I will copy "Deposits 070909" and "Open Balance 070909" to my archive folder and, in the current folder, rename them "Deposits 071009" and "Open Balance 071009." There are also a couple of Excel files in my current folder that do not end in dates, and those I use every day without copying or renaming.

Can someone help me to get this to happen automatically?

I figure I could rename each file with something like this:

Code:
newname=substitute(oldname,mid(oldname,find(".",oldname)-6,6),format(date,"mmddyy"))

...but I don't know how to loop through the files or how to change the names while they're closed - or how to determine if they end in a date.

Thanks for helping me :)

Tai
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Thanks!

A couple more questions:

How do I check whether the name ends in mmddyy (i.e., looks like 070909)?

How do I loop through the files? Should I put the code into a file in the folder, then have vba use its path to determine what folder I'm in and loop through all the files to rename them? How would I implement that?

Thanks,
Tai
 
Upvote 0
This will help you determine if the file ends in MMDDYY

Code:
    If IsDate(Left(Mid(oldname, InStr(1, oldname, ".") - 6, 6), 2) _
              & "/" & Mid(Mid(oldname, InStr(1, oldname, ".") - 6, 6), 3, 2) _
              & "/" & Right(Mid(oldname, InStr(1, oldname, ".") - 6, 6), 2)) Then
        '=======================================================================
        'FILE ENDS IN MMDDYY format
        '=======================================================================
    Else
        '=======================================================================
        'FILE DOES NOT END IN MMDDYY format
        '=======================================================================
    End If
 
Upvote 0
This will bring your workbook names into an array, then loop through the array and identify if they end in MMDDYY or not. ;)

Code:
Private Sub Test()
'assign the file names to an array
    Dim strFileArray()
    Dim lngLoop As Long
    With Application.FileSearch
        .NewSearch          '           /======================
        .LookIn = "C:\dal\"    '<======= REPLACE WITH YOUR PATH
        .SearchSubFolders = False '     \======================
        .FileType = msoFileTypeExcelWorkbooks
        .Execute
        ReDim strFileArray(.FoundFiles.Count)
        For lngLoop = 1 To .FoundFiles.Count
            strFileArray(lngLoop) = .FoundFiles(lngLoop)
        Next lngLoop
    End With
    For x = 1 To UBound(strFileArray) ' Loop through the file names
        oldname = strFileArray(x)
        If IsDate(Left(Mid(oldname, InStr(1, oldname, ".") - 6, 6), 2) _
                  & "/" & Mid(Mid(oldname, InStr(1, oldname, ".") - 6, 6), 3, 2) _
                  & "/" & Right(Mid(oldname, InStr(1, oldname, ".") - 6, 6), 2)) Then
            '=======================================================================
            'FILE ENDS IN MMDDYY format
            'Do with it what ya want
            '=======================================================================
        Else
            '=======================================================================
            'FILE DOES NOT END IN MMDDYY format
            '=======================================================================
        End If
    Next    'x
End Sub
 
Upvote 0
This is how I do it.
I pull the files to be changed in A11 and down with a button click (A).
In B11 and down, I enter the new names without path and without extension.
In C11 I’ll get the renamed filenames incl. path and extension (B).
Then I change the filenames in the folder (C).

A
Code:
Sub FindTheFiles()
Dim arrFiles
Dim i As Integer

    arrFiles = Application.GetOpenFilename("All Files (*.*), *.*", , , , True)
For i = 1 To UBound(arrFiles)
    ActiveSheet.Cells(10 + i, 1).Value = arrFiles(i)
Next i
Range("A11").Cut Destination:=Range("A65536").End(xlUp).Offset(1, 0)
Range("A11").Delete Shift:=xlUp   
End Sub

B
Code:
Sub ChangeFileName()
    Dim OldName As String
    Dim Ext As String
    Dim MyStr As String
    Dim LastRow As Long, i As Long
    Application.ScreenUpdating = False
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 11 To LastRow
        MyStr = Range("A" & i)
        OldName = Split(MyStr, "\")(UBound(Split(MyStr, "\")))
        Ext = "." & Split(MyStr, ".")(UBound(Split(MyStr, ".")))
        Range("C" & i) = Left(MyStr, Len(MyStr) - Len(OldName)) & Range("B" & i) & Ext
    Next i
    Application.ScreenUpdating = True
End Sub

C
Code:
Sub ChangeInFolder()
Dim OldName As String
Dim NewName As String
Dim LastRow As Long
Dim i As Long
LastRow = Range("A65536").End(xlUp).Row

For i = 11 To LastRow
    OldName = Range("A" & i).Value
    NewName = Range("C" & i).Value
    Name OldName As NewName
Next i
Application.ScreenUpdating = True
End Sub

All put together with the help of these helpful people on these forums.

HTH

John
 
Upvote 0
Thanks a lot to both of you.

I know I made it sound like I could put the pieces together, but thanks for not rubbing my nose in it when it turned out that I wanted you to just solve the problem for me altogether!

...I will be sure to thoroughly understand both the codes and then try to give back to the community :)
 
Upvote 0

Forum statistics

Threads
1,214,994
Messages
6,122,633
Members
449,092
Latest member
bsb1122

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top