title: Rename Subfolder folder name with File name inside the folder - vba
body: <p>Can someone help me with VBA code to rename the subfolder with the part of file name as given below</p>
  
  <p>Folder : C:\Test</p>
  
  <p>Sub folders : C:\Test\a , C:\Test\b , C:\Test\a .... Goes on</p>
  
  <p>It has some file contents and I have to match a file with name starting with VDX_000674 and get last 4 characters and rename the Folder with that.</p>
  
  <p>I have tried the below code but with no use any edits will be appreciated</p>
  
  <pre><code>Sub Rename()
      Call Test_Rename("C:\Users\shanmso\Desktop\VN\Output")
  End Sub
  
  Sub Test_Rename(MyPath As String)
  
      Dim FileSys As FileSystemObject
      Dim objFolder As Folder
      Dim objSubFolder As Folder
      Dim objFile As File
      Dim Riname As String
  
      Set FileSys = CreateObject("Scripting.FileSystemObject")
      Set objFolder = FileSys.GetFolder(MyPath)
  
      For Each objFile In objFolder.Files
          If Left(objFile.Name, 15) = "DEX-VH_00000374" Then
              Riname = Mid(objFile.Name, 17, 3)
              Name objFolder As Riname
              Exit For
          End If
  
      Next objFile
  
      For Each objSubFolder In objFolder.SubFolders
          Test_Rename MyPath &amp; "\" &amp; objSubFolder.Name
      Next objSubFolder
  
      Set FileSys = Nothing
      Set objFolder = Nothing
      Set objSubFolder = Nothing
      Set objFile = Nothing
  
  End Sub
  </code></pre>