Copy Folder from C:\ and rename using multiple cell values

donnieFranklin

New Member
Joined
Feb 13, 2021
Messages
15
Office Version
  1. 365
Platform
  1. Windows
I'm trying to setup macro on spreadsheet to copy a folder from my C:\Users\dfranklin\desktop\New folder and rename the folder based on the value from Multiple cells in the same Row., Would like to have a simple way to run the command on selected row.

Example
C:Users\dfranklin\desktop\10256_My Example_Ny City_Usa
10256​
My ExampleNy CityUsa
 

Some videos you may like

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

kanadaaa

Board Regular
Joined
Dec 29, 2019
Messages
186
Office Version
  1. 365
Platform
  1. Windows
Try this:

VBA Code:
'THIS CODE PRESUPPOSES THE VALUES ARE IN ROW 1, COLUMNS 1-4
Sub RenameMyFolders()
    Dim OldFolderName, NewFolderName As String
    Dim objFileSystem As Object

    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    
    'Path for old folder and renamed folder
    OldFolderName = "C:Users\dfranklin\desktop\New folder\"
    NewFolderName = "C:Users\dfranklin\desktop\" & Range("A1").Value & "_" & Range("B1").Value & "_" & Range("C1").Value & "_" & Range("D1").Value & "\"

    'Check if renamed folder already exist
    If objFileSystem.FolderExists(NewFolderName) = False Then
        'Rename the original folder
        Name OldFolderName As NewFolderName
        MsgBox "Target Folder is renamed"
    Else
        MsgBox "Target Folder already exists with same name"
    End If
End Sub
 

donnieFranklin

New Member
Joined
Feb 13, 2021
Messages
15
Office Version
  1. 365
Platform
  1. Windows
Try this:

VBA Code:
'THIS CODE PRESUPPOSES THE VALUES ARE IN ROW 1, COLUMNS 1-4
Sub RenameMyFolders()
    Dim OldFolderName, NewFolderName As String
    Dim objFileSystem As Object

    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
   
    'Path for old folder and renamed folder
    OldFolderName = "C:Users\dfranklin\desktop\New folder\"
    NewFolderName = "C:Users\dfranklin\desktop\" & Range("A1").Value & "_" & Range("B1").Value & "_" & Range("C1").Value & "_" & Range("D1").Value & "\"

    'Check if renamed folder already exist
    If objFileSystem.FolderExists(NewFolderName) = False Then
        'Rename the original folder
        Name OldFolderName As NewFolderName
        MsgBox "Target Folder is renamed"
    Else
        MsgBox "Target Folder already exists with same name"
    End If
End Sub
Okay this works for renaming my current folder. But the current folder is a template and i need it to stay in place. So i need to Create a new folder first then rename.

Also if i could set a cell on the sheet to pick which Row to reference. This code will create a folder based on thousands of rows. So looking for any easy way to change rows.

BTW thanks for the help!
 

kanadaaa

Board Regular
Joined
Dec 29, 2019
Messages
186
Office Version
  1. 365
Platform
  1. Windows
How about this one then.
VBA Code:
Sub CreateFolderOnDesktop()
    Dim fName As String, genPath As String, fPath As String, r As Range
  
    On Error GoTo errhandler
    Set r = Application.InputBox("Select a cell in a row after which you'd like to name the folder you're creating.", "Folder Name Choice", Type:=8)
  
    If r.Rows.Count = 1 Then
        genPath = Environ("USERPROFILE") & "\Desktop\" 'Find Desktop path location
        fName = Range("A" & r.Row) & "_" & Range("B" & r.Row) & "_" & Range("C" & r.Row) & "_" & Range("D" & r.Row) 'Define folder name to create on the desktop
        fPath = genPath & fName 'Folder Path
        Set oFSO = CreateObject("Scripting.FileSystemObject") 'Create FSO Object
  
        If oFSO.FolderExists(fPath) Then 'If folder is available on the desktop
            MsgBox "Specified folder already exists on the desktop.", vbExclamation, "Error"
            Exit Sub
        Else
            MkDir fPath  'Create Folder
            MsgBox "Folder has been created : " & vbCrLf & vbCrLf & fPath, vbInformation, "Notification"
            Debug.Print fPath 'In case you lose sight of the created folder
        End If
    Else
        MsgBox "Please select one row.", vbExclamation, "Error"
    End If
  
Exit Sub
errhandler: 'Do nothing
End Sub
 

donnieFranklin

New Member
Joined
Feb 13, 2021
Messages
15
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Sub CreateFolderOnDesktop() Dim fName As String, genPath As String, fPath As String, r As Range On Error GoTo errhandler Set r = Application.InputBox("Select a cell in a row after which you'd like to name the folder you're creating.", "Folder Name Choice", Type:=8) If r.Rows.Count = 1 Then genPath = Environ("USERPROFILE") & "\Desktop\" 'Find Desktop path location fName = Range("A" & r.Row) & "_" & Range("B" & r.Row) & "_" & Range("C" & r.Row) & "_" & Range("D" & r.Row) 'Define folder name to create on the desktop fPath = genPath & fName 'Folder Path Set oFSO = CreateObject("Scripting.FileSystemObject") 'Create FSO Object If oFSO.FolderExists(fPath) Then 'If folder is available on the desktop MsgBox "Specified folder already exists on the desktop.", vbExclamation, "Error" Exit Sub Else MkDir fPath 'Create Folder MsgBox "Folder has been created : " & vbCrLf & vbCrLf & fPath, vbInformation, "Notification" Debug.Print fPath 'In case you lose sight of the created folder End If Else MsgBox "Please select one row.", vbExclamation, "Error" End If Exit Sub errhandler: 'Do nothing End Sub


Sorry i didn't specify i needed to copy the template folder which i can specify the file path. then rename it.
This file created will not reside on my desktop. It will be located on a drive. So the Userprofile call will not work.
I can also specifiy the new file path.
 

kanadaaa

Board Regular
Joined
Dec 29, 2019
Messages
186
Office Version
  1. 365
Platform
  1. Windows
Then try:
VBA Code:
Sub CopyFolderAndRename()
    Dim fPath As String, rootPath As String, folderName As String, r As Range
    
    rootPath = "C:Users\dfranklin\desktop\" 'File address without file name
    folderName = "New folder" ' The name of folder to copy
    
    
    On Error GoTo errhandler
    Set r = Application.InputBox("Select a cell in a row after which you'd like to name the folder you're creating.", "Folder Name Choice", Type:=8)
    
    If r.Rows.Count = 1 Then
        fPath = rootPath & Range("A" & r.Row) & "_" & Range("B" & r.Row) & "_" & Range("C" & r.Row) & "_" & Range("D" & r.Row)
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        oFSO.CopyFolder rootPath & folderName, fPath
        MsgBox "Folder has been created : " & vbCrLf & vbCrLf & fPath, vbInformation, "Notification"
        Debug.Print fPath 'In case you lose sight of the created folder
    Else
        MsgBox "Please select one row.", vbExclamation, "Error"
    End If
    
Exit Sub
errhandler: MsgBox "Error has occured.", vbExclamation, "Error"
End Sub
 

donnieFranklin

New Member
Joined
Feb 13, 2021
Messages
15
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Then try:
VBA Code:
Sub CopyFolderAndRename()
    Dim fPath As String, rootPath As String, folderName As String, r As Range
   
    rootPath = "C:Users\dfranklin\desktop\" 'File address without file name
    folderName = "New folder" ' The name of folder to copy
   
   
    On Error GoTo errhandler
  [U][S][COLOR=rgb(226, 80, 65)]  [/COLOR][/S][/U][COLOR=rgb(0, 0, 0)][U]Set r = Application.InputBox("Select a cell in a row after which you'd like to name the folder you're creating.", "Folder Name Choice", Type:=8)[/U][/COLOR]
   
    If r.Rows.Count = 1 Then
        fPath = rootPath & Range("A" & r.Row) & "_" & Range("B" & r.Row) & "_" & Range("C" & r.Row) & "_" & Range("D" & r.Row)
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        oFSO.CopyFolder rootPath & folderName, fPath
        MsgBox "Folder has been created : " & vbCrLf & vbCrLf & fPath, vbInformation, "Notification"
        Debug.Print fPath 'In case you lose sight of the created folder
    Else
        MsgBox "Please select one row.", vbExclamation, "Error"
    End If
   
Exit Sub
errhandler: MsgBox "Error has occured.", vbExclamation, "Error"
End Sub
I can run this code in debug Step Into.
Once i make it to the Set r=Application.InputBox line the Input box appers and i select an item in Column A Row 208. It then gives an error.
 

kanadaaa

Board Regular
Joined
Dec 29, 2019
Messages
186
Office Version
  1. 365
Platform
  1. Windows
I can run this code in debug Step Into.
Once i make it to the Set r=Application.InputBox line the Input box appers and i select an item in Column A Row 208. It then gives an error.
Is it that the code stops on that line or msgbox shows up?
 

kanadaaa

Board Regular
Joined
Dec 29, 2019
Messages
186
Office Version
  1. 365
Platform
  1. Windows
You have to specify rootPath and folderName for youself.
The code below lets you know if the specified path is not found:
VBA Code:
Sub CopyFolderAndRename()
    Dim fPath As String, rootPath As String, folderName As String, r As Range
 
    rootPath = "C:Users\dfranklin\desktop\" 'File address without file name
    folderName = "New folder" ' The name of folder to copy
 
    Set oFSO = CreateObject("Scripting.FileSystemObject")
 
    If oFSO.FolderExists(rootPath & folderName) = False Then
        MsgBox "Path not found.", vbExclamation, "Error"
    Else
        On Error GoTo errhandler
        Set r = Application.InputBox("Select a cell in a row after which you'd like to name the folder you're creating.", "Folder Name Choice", Type:=8)
 
        If r.Rows.Count = 1 Then
            fPath = rootPath & Range("A" & r.Row) & "_" & Range("B" & r.Row) & "_" & Range("C" & r.Row) & "_" & Range("D" & r.Row)     
            oFSO.CopyFolder rootPath & folderName, fPath
            MsgBox "Folder has been created : " & vbCrLf & vbCrLf & fPath, vbInformation, "Notification"
            Debug.Print fPath 'In case you lose sight of the created folder
        Else
            MsgBox "Please select a cell in one row.", vbExclamation, "Error"
        End If
    End If
 
Exit Sub
errhandler:
End Sub
 

donnieFranklin

New Member
Joined
Feb 13, 2021
Messages
15
Office Version
  1. 365
Platform
  1. Windows
Okay. The file path was incorrect so i fixed that.
Now the code runs but does not create a folder. Message box does show and i select a cell. THen nothing happens and no new folder in the rootpath folder.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,952
Messages
5,599,033
Members
414,275
Latest member
Pungie

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
Top