Copy List of Folders, Subfolders and Files to New Location

Hi Experts,

I'm attempting to Copy a multiple list of folders and all the contents within them (Subfolders and Files) that are listed in column A to the new location list in column B. I've attempted using the code below but I'm getting the Run-time error '91' Object variable or with block variable not set at the folder line near the bottom.

Sub CopyFolders()

    Dim Cell As Range
    Dim oFolder As Object
    Dim oShell As Object
    Dim Rng As Range
    Dim RngEnd As Range
    Dim Wks As Worksheet
    
        Set Wks = ActiveSheet
        Set Rng = Wks.Range("A1")
        Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
        
        Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
        
        Set oShell = CreateObject("Shell.Application")
        
        
            For Each Cell In Rng
                Set oFolder = oShell.Namespace(Cell.Offset(0, 1))   ' New folder path in column "B"
                oFolder.CopyHere Cell                               ' Copy folder to the new path
            Next Cell
            
End Sub

Any help would be greatly appreciated as this would really save me a lot of time.

Thanks in advance.

Try...

oFolder.CopyHere Cell.Value

Thanks for your reply dangelor. I tried what you suggested but still get the same resulting error.

Possibly...

Sub CopyFolders()

    '''Not Tested - - - Will overwrite files in Destination'''

  ...
    With CreateObject("FileSystemObject")
        .copyfolder Cell.Offset(, 1).Value, Cell.Value
    End With
End Sub

Thanks for your assistance Dangelor, this time I get the error run Tim 429 activex component can't create object.

Hi MusicMan
I made a tool for updating License on my applications.
There are also functions to move files, replace them, change extentions and other things.
You are welcome to use it.
I also got some help with mine, so only fair to share.

It might take a few go's to find out how it works, but it should be straight forward.

Happy hours

Try this code...

Sub CopyFolders()

    '''Will overwrite files in Destination'''

    Dim Cell As Range
    Dim Rng As Range
    Dim RngEnd As Range
    Dim Wks As Worksheet

    Set Wks = ActiveSheet
    Set Rng = Wks.Range("A1")
    Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
    
    With CreateObject("Scripting.FileSystemObject")
        For Each Cell In Rng
            .copyfolder Cell.Offset(, 1), Cell & "\"
        Next Cell
    End With
End Sub

Thanks nordicdust but I did not see anything there for moving the folders like I needed. Dangelor, when I run this code I get the error path not found. I double and triple checked to ensure that the paths are there.

Do your paths end with a \?

I've tried it with and without.

Can you post a 'dummy' file?


Please attach a sample workbook (not a picture or pasted copy). Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.