Rename files from a list in Excel

[PhoenixMM]

I really need help,

I need two Macros. On running the first one, asks the user where the folder is. Then it should list all the files from a folder and any files from sub folders within the main folder. It puts all the names in column A.

TestFile.pdf
TestFile2.pdf
TestFile.xsl
TestFile3.doc

The second Macro, Then looks in column B and renames the files to whats entered init.

TestRecords.pdf
TestReport.pdf
TestSheet.xsl
TestFile.doc

I am a newbie and have no idea what i need to do.

Please help

 

[Weaver]

When you say "Newbie", just how much do you know? Hopefully this will be as simple as possible.

In the vb window, insert a new module and paste all of the following code

Option Compare Text

Sub macro1()
    Dim folderPath As String, nextFile As String, i As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            Range("A:C").ClearContents
            Range("A1") = "Path:"
            folderPath = .SelectedItems(1)
            Range("B1") = folderPath
            nextFile = Dir(folderPath & "\*.*")
            i = 3
            Do While nextFile <> ""
                Cells(i, "A") = nextFile
                i = i + 1
                nextFile = Dir
            Loop
            Columns(1).EntireColumn.AutoFit
        Else
            MsgBox "No folder selected"
        End If
    End With
End Sub

Sub macro2()
    Dim folderPath As String, nextFile As String, i As Long, lr As Long
    Dim oldName As String, newName As String
    folderPath = Range("B1").Value
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 3 To lr
        oldName = Cells(i, "A")
        newName = Cells(i, "B")
        If newName <> "" Then
            oldName = folderPath & "\" & oldName
            newName = folderPath & "\" & checkSuffix(oldName, newName)
            If Not fileExists(newName) Then
                Name oldName As newName
                Cells(i, "C") = "Complete"
            Else
                Cells(i, "C") = "Failed"
            End If
        End If
    Next i
    Shell "Explorer " & folderPath, vbNormalFocus
End Sub

Function fileExists(ByVal str As String) As Boolean
    fileExists = (Dir(str) <> "")
End Function

Function checkSuffix(ByVal o As String, n As String)
    f = Split(o, ".")
    s = f(UBound(f))
    If Right(n, Len(s)) = s Then
        checkSuffix = n
    Else
        checkSuffix = n & "." & s
    End If
End Function

Create a clean tab and run macro1. This will create your initial list. You can run the code by pressing alt +F8 and choosing the relevant macro, or you can create buttons and call the macros from these.

In column B, add your new file names. You can omit the suffix's (.doc, .xls etc) as the code will add these back in if they're not there or wrong.

The you can run macro2 and the files will be renamed. Best to test on copies of your files. Column C gets a comment which will say 'failed' if the filename you supplied already exists. Anything with a blank in B gets ignored.

HTH

 

[PhoenixMM]

I WANT YOUR BABIES!!!!!!

It worked.

Do you know a way i can lock the list in column A so that no one can change the list, and if they click on the a cell in the list to change it it should them to "Please make file name change in column B only"?

 

[PhoenixMM]

I WANT YOUR BABIES!!!!!!

It worked.

Do you know a way i can lock the list in column A so that no one can change the list, and if they click on the a cell in the list to change it it should them to "Please make file name change in column B only"?

WOW, i should really preview the reply before i submit. Some REALLY bad english.

I should have stated:

I WANT YOUR BABIES!!!!!!

It worked.

Do you know a way i can lock the list in column A so that no one can change it (But when macro 1 runs it is able to relist with no problems), and if they click on a cell in the list to change it, then it should tell them to "Please make file name change in column B only"?

 

[Weaver]

Right click the sheet tab, choose 'view code' from the menu and paste the following

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 1 Then
        MsgBox "Please make file name change in column B only"
    End If
End Sub

PS No problem!

 

[PhoenixMM]

Right click the sheet tab, choose 'view code' from the menu and paste the following

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 1 Then
        MsgBox "Please make file name change in column B only"
    End If
End Sub

PS No problem!

This only displays a message, it doesnt lock the values from A3 downwards.

 

[Weaver]

This only displays a message, it doesnt lock the values from A3 downwards.

I thought that might be enough. Obviously your users are more than determined to throw a spanner in the works!

try

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 1 And Target.Row > 2 And Target.Value <> "" Then
        MsgBox "Please make file name change in column B only"
        Cells(Target.Row, 2).Select
    End If
End Sub

 

[PhoenixMM]

That Works

2 last things;

I want to give the user the ability to highlight values in the list (A3 down wards) so that can copy and paste it in to column B to make changes to the names of files (so they do not need to type the whole file name again to make a little change). At the moment when you select for example A3:A5 a Run-Time error '13': type mismatch happens.

Also when the Macro 1 runs to get the file names i wanted it to adjust the row height as it gets the file name.

 

[Weaver]

Since you can only trap a change to a cell after it's been changed, using the change event won't work. We could protect the cells so that they can't be changed but then you'd have to unprotect them every time you run macro1. Therefore, the easiest way to get what you need is to duplicate column A into column B
change

Cells(i, "A") = nextFile

to

Cells(i, "A").resize(,2) = nextFile

then users can amend, delete or completely replace the values in column B.

As for the other thing, I'm not sure as to why you'd want to adjust the row height, but if you do, add the line

ActiveSheet.UsedRange.EntireRow.AutoFit

into macro1 after the line

Columns(1).EntireColumn.AutoFit

 

[PhoenixMM]

This has now solved all my problems.

Thank you for all the help you have given me. Let me know if there is away i can say thanks.