Copying files to a newly created folder named from data within spreadsheet

AndyEd

Board Regular
Joined
May 13, 2020
Messages
124
Office Version
  1. 365
Platform
  1. Windows
I have the following code to create a folder at a location specified by the user,

VBA Code:
openAt = "My computer:"

Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose where to create the folder", 0, openAt)

On Error Resume Next
BrowseForFolder = ShellApp.Self.Path

MkDir (BrowseForFolder & "\" & Workbooks("Create folders & files").Worksheets("Tracker").Range("A2").value & _
"." & Right(Workbooks("Create folders & files").Worksheets("Tracker").Range("I2"), 4) & _
" - " & Workbooks("Create folders & files").Worksheets("Tracker").Range("E2").value)

I also have the following code which currently copies a named file into a specified folder within the DestinationPath string.

VBA Code:
Dim SourcePath As String
Dim DestinationPath As String

SourcePath = "C:\TEMPLATE\1. Front sheet.xlsm"
DestinationPath = "C:\test\1. Front sheet.xlsm"
FileCopy SourcePath, DestinationPath

Would someone be so kind as to help me by explaining how I could copy the file into the folder created within the initial piece of code, all within the same subroutine, if possible.

Many thanks.
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Try this macro:
VBA Code:
Public Sub Create_Subfolder_and_Copy_File()

    Dim openAt As String, ShellApp As Object, BrowseForFolder As String
    Dim SourcePath As String
    Dim DestinationPath As String
    
    openAt = "My computer:"
    
    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose where to create the folder", 0, openAt)
    If ShellApp Is Nothing Then
        MsgBox "User cancelled", vbInformation
        Exit Sub
    End If
    
    'On Error Resume Next
    BrowseForFolder = ShellApp.Self.Path
    
    With Workbooks("Create folders & files").Worksheets("Tracker")
        BrowseForFolder = BrowseForFolder & "\" & .Range("A2").Value & "." & Right(.Range("I2"), 4) & " - " & .Range("E2").Value
    End With
    
    MkDir BrowseForFolder
    
    SourcePath = "C:\TEMPLATE\1. Front sheet.xlsm"
    DestinationPath = BrowseForFolder & "\1. Front sheet.xlsm"
    FileCopy SourcePath, DestinationPath

End Sub
 
Upvote 1
Solution

Forum statistics

Threads
1,215,077
Messages
6,122,992
Members
449,094
Latest member
masterms

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