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

D

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
 
Sort by date Sort by votes
kanadaaa said:
That's it. Here's a workaround:
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)
            If InStr(fPath, "/") > 0 Then
                fPath = Replace(fPath, "/", " ")
            End If
            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: 'MsgBox "Error has occured.", vbExclamation, "Error"
End Sub
Click to expand...
That's It.

Thank you SO MUCH!
Your awesome!
Donnie
 
Upvote 0

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
donnieFranklin said:
That's It.

Thank you SO MUCH!
Your awesome!
Donnie
Click to expand...
Glad I could help.
I edited the code further and here's a perfect workaround (Every time the macro fails to run properly, you'll know why with this one):
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)
            'Copy and paste the following lines and edit "/" to whatever character that file names can't contain
            '================================
            If InStr(fPath, "/") > 0 Then            '<= "/" to edit
                fPath = Replace(fPath, "/", " ")    '<= "/" to edit
            End If
            '================================
            On Error GoTo errhandler2
            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: 'Do nothing if selection in canceled
errhandler2: MsgBox "The folder name contains characters that can't be in file names.", vbExclamation, "Error"
End Sub
 
Last edited:
Upvote 0
kanadaaa said:
Glad I could help.
I edited the code further and here's a perfect workaround (Every time the macro fails to run properly, you'll know why with this one):
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)
            'Copy and paste the following lines and edit "/" to whatever character that file names can't contain
            '================================
            If InStr(fPath, "/") > 0 Then            '<= "/" to edit
                fPath = Replace(fPath, "/", " ")    '<= "/" to edit
            End If
            '================================
            On Error GoTo errhandler2
            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: 'Do nothing if selection in canceled
errhandler2: MsgBox "The folder name contains characters that can't be in file names.", vbExclamation, "Error"
End Sub
Click to expand...


This works perfectly for my application.
I'd like to do one small upgrade. I'd like to change the background color of cells A thru G of the row selected. This helps keep track of which Rows have already been ran through the macro.

I tried to look online and edit the code but it did'nt work :(

Any help would be great
 
Upvote 0
Try this:
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
        Sheets("2021 Proposals").Activate
        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)
            'Copy and paste the following lines and edit "/" to whatever character that file names can't contain
            '==============================
            If InStr(fPath, "/") > 0 Then            '<= "/" to edit
                fPath = Replace(fPath, "/", " ")    '<= "/" to edit
            End If
            '==============================
            If oFSO.FolderExists(fPath) = True Then
                MsgBox "There already exists a folder with the same name.", vbExclamation, "Error"
                Exit Sub
            End If
            On Error GoTo errhandler2
            oFSO.CopyFolder rootPath & folderName, fPath
            Range("A" & r.Row).Resize(, 7).Interior.ColorIndex = 15
            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: 'Do nothing if selection is canceled
errhandler2: MsgBox "The folder name contains characters that can't be in file names.", vbExclamation, "Error"
End Sub
 
Upvote 0
Tried this. The excel sheet resides in a seperate folder from the rootpath. Thus it will also need to be specified.
 
Upvote 0
I just added a function to the code in #24 as you requested in:
donnieFranklin said:
I'd like to change the background color of cells A thru G of the row selected.
Click to expand...
And
donnieFranklin said:
The excel sheet resides in a seperate folder from the rootpath.
Click to expand...
I don’t know the path of your worksheet so you’ll need to specify that on your own.
 
Upvote 0
These lines primarily:
VBA Code: 
    rootPath = "C:\Users\dfranklin\desktop\" 'File address without file name
    folderName = "New folder" 'The name of folder to copy
And that line secondarily.
Guessing from your post in #25 the part you need to modify is the first one.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
VBA help required in creating multiple workbooks from one workbook.
Replies
5
Views
401
jolivanes
jolivanes
G
  • Solved
Change Macro to import files from hyperlinks
2
Replies
12
Views
554
GarnesGambit
G
I
  • Question
Create folder & name it using value in worksheet cell
Replies
1
Views
184
ipbr21054
I
I
  • Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
414
Insurance Dave
I
S
  • Solved
For each row, create new folder based on single cell value, then save exported XML doc to matching folder.
Replies
3
Views
264
shand
S

Forum statistics

Threads
1,216,441
Messages
6,130,643
Members
449,585
Latest member
Nattarinee

Share this page

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
Back
Top