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

[donnieFranklin]

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 Example

Ny City

Usa

 

[kanadaaa]

Try this:

'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]

Try this:

'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]

How about this one then.

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]

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]

Then try:

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]

Then try:

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]

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]

You have to specify rootPath and folderName for youself.
The code below lets you know if the specified path is not found:

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]

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.