none
Rename different file types in a folder

    Question

  • I am using this code to get a list of subfolders that show up in Column(1)

    Sub ListSubFolders()

    'Dave Morrison Dim fs, f, f1, fc, s, tr Dim foldr foldr = "C:\Rename Folders\" Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(foldr) Set fc = f.SubFolders For Each f1 In fc tr = InStr(4, f1, "\") + 1 Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = Mid(f1, tr, 99) Next f1 End Sub

    The next bit of code renames the folders with what is in the column next to it.

    Sub RenameFolders()
    
        Dim OrigNm As String, NewNm As String
        Dim Rws As Long, Rng As Range, c As Range, BRng As Range, Brws As Long
    
        Rws = Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(Cells(2, 1), Cells(Rws, 1))
        Brws = Cells(Rows.Count, "B").End(xlUp).Row
        Set BRng = Range(Cells(2, 2), Cells(Brws, 2))
    
        If BRng.Count = Rng.Count Then
    
            For Each c In Rng.Cells
    
                On Error Resume Next
                OrigNm = "C:\Rename Folders\" & c
                NewNm = "C:\Rename Folders\" & c.Offset(0, 1)
    
                Name OrigNm As NewNm
    
            Next c
            
        Else: MsgBox "Amount of New names does not equal the amount of old names"
    
        End If
        
    End Sub

    Some of the files in those folders contain the folder name at the beggining.

    Is ther a way to search for each of the files that contain the old folder name and replace it it with the new folder name.

    Doing this without a loop would be more efficient, because there could be up to 100 files in a folder, but maybe only four of those files contain the folder name.

    Please see the attached examples

    http://www.davesexcel.com/Rename%20Folders.zip

    http://www.davesexcel.com/Replace%20Folder%20Names.xlsm


    davesexcel


    Wednesday, April 11, 2012 11:21 AM

Answers

  • Here is the general idea (error checking not included):

    Sub UpdateFileNames(strFolder As String, ByVal strOldName As String)
    
        Set objFso = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFso.GetFolder(strFolder)
        
        For Each objFile In objFolder.Files
            objFile.Name = Replace(objFile.Name, strOldName, objFolder.Name, , , vbTextCompare)
        Next
    
    End Sub

    Then you can use the function in your RenameFolders() after renaming a folder:

    Sub RenameFolders()
    
        Dim OrigNm As String, NewNm As String
        Dim Rws As Long, Rng As Range, c As Range, BRng As Range, Brws As Long
    
        Rws = Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(Cells(2, 1), Cells(Rws, 1))
        Brws = Cells(Rows.Count, "B").End(xlUp).Row
        Set BRng = Range(Cells(2, 2), Cells(Brws, 2))
    
        If BRng.Count = Rng.Count Then
    
            For Each c In Rng.Cells
    
                On Error Resume Next
                OrigNm = "C:\Scripts\" & c
                NewNm = "C:\Scripts\" & c.Offset(0, 1)
    
                Name OrigNm As NewNm
                UpdateFileNames NewNm, c
    
            Next c
            
        Else: MsgBox "Amount of New names does not the amount of old names"
    
        End If
        
    End Sub


    Uros Calakovic


    Friday, April 13, 2012 7:27 PM

All replies

  • Does this help?

    http://www.rondebruin.nl/copy4.htm


    Ryan Shuell

    Wednesday, April 11, 2012 8:02 PM
  • Thanks for the reply Ryan.


    davesexcel http://www.davesexcel.com/

    Thursday, April 12, 2012 3:19 AM
  • Did it work for you?  The concept is different from your own, but I think it will help you achieve what you are looking to achieve .

    Ryan Shuell

    Thursday, April 12, 2012 1:58 PM
  • No,

    My question and the site you suggested has no relationship.


    davesexcel



    Friday, April 13, 2012 1:10 PM
  • Here is the general idea (error checking not included):

    Sub UpdateFileNames(strFolder As String, ByVal strOldName As String)
    
        Set objFso = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFso.GetFolder(strFolder)
        
        For Each objFile In objFolder.Files
            objFile.Name = Replace(objFile.Name, strOldName, objFolder.Name, , , vbTextCompare)
        Next
    
    End Sub

    Then you can use the function in your RenameFolders() after renaming a folder:

    Sub RenameFolders()
    
        Dim OrigNm As String, NewNm As String
        Dim Rws As Long, Rng As Range, c As Range, BRng As Range, Brws As Long
    
        Rws = Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(Cells(2, 1), Cells(Rws, 1))
        Brws = Cells(Rows.Count, "B").End(xlUp).Row
        Set BRng = Range(Cells(2, 2), Cells(Brws, 2))
    
        If BRng.Count = Rng.Count Then
    
            For Each c In Rng.Cells
    
                On Error Resume Next
                OrigNm = "C:\Scripts\" & c
                NewNm = "C:\Scripts\" & c.Offset(0, 1)
    
                Name OrigNm As NewNm
                UpdateFileNames NewNm, c
    
            Next c
            
        Else: MsgBox "Amount of New names does not the amount of old names"
    
        End If
        
    End Sub


    Uros Calakovic


    Friday, April 13, 2012 7:27 PM