How can I use the FileSystemObject to "Copy and rename"

Question

Using the FileSystemObject in VB/VBA (or native VBA calls, I guess) how can I:

1. Copy folder
2. Rename folder

So, something like:

mFSO.CopyAndRename(targetFolder, copyDirectory, copyFolderName)

I have basically done this myself but I would much prefer a more clean method call such as the above (and the CopyFolder method). This seems like a lot of code and a lot of potential failure points...

'
''requires reference to Microsoft Scripting Runtime


Public Function CopyDirectory(ByVal p_copyDirectory As String, p_targetDirectory As String, Optional p_newName As String = "") As Boolean
    CopyDirectory = False
    Dim m_fso 
    Set m_fso = New FileSystemObject

    Dim mFolder, mNewFolder

    If Not Me.DoesPathExist(p_copyDirectory) Then
        Exit Function
    Else

        On Error GoTo errHandler
         Set mFolder = m_fso.GetFolder(p_copyDirectory)
         mFolder.Copy p_targetDirectory, False

         'rename if a "rename" arg is passed
         If p_newName <> "" Then
            If DoesPathExist(p_targetDirectory & mFolder.Name) Then
                Set mNewFolder = m_fso.GetFolder(p_targetDirectory & mFolder.Name)
                mNewFolder.Name = "test" & CStr(Rnd(9999))
            Else
            End If
         End If

         CopyDirectory = True
        On Error GoTo 0

        Exit Function
    End If

errHandler:
    Exit Function

End Function

Solution 1

There is actually a method on Scripting.FileSystemObject called CopyFolder. It can be used to do both the copy and rename in one step, as follows:

Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.copyFolder "C:\Path\to\source\folder", "C:\Path\to\destination\folder" true

I found the code here: http://vba-tutorial.com/copy-a-folder-and-all-of-its-contents/

Hope this answers your question.

Solution 2

My Fav: SHFileOperation API

This also gives you the visual presentation of Folders being moved.

Option Explicit

Private Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Const FO_COPY = &H2 '~~> Copy File/Folder
Const FOF_SILENT = &H4 '~~> Silent Copy

Private Type SHFILEOPSTRUCT
    hwnd      As Long
    wFunc     As Long
    pFrom     As String
    pTo       As String
    fFlags    As Integer
    fAborted  As Boolean
    hNameMaps As Long
    sProgress As String
End Type

Private Sub Sample()
    Dim lresult  As Long, lFlags   As Long
    Dim SHFileOp As SHFILEOPSTRUCT

    With SHFileOp
        '~~> For Copy
        .wFunc = FO_COPY
        .pFrom = "C:\Temp"
        .pTo = "C:\Temp2\"
        '~~> For Silent Copy
        '.fFlags = FOF_SILENT
    End With
    lresult = SHFileOperation(SHFileOp)

    '~~> SHFileOp.fAborted will be true if user presses cancel during operation
    If lresult <> 0 Or SHFileOp.fAborted Then Exit Sub

    MsgBox "Operation Complete", vbInformation, "File Operations"
End Sub

For renaming a folder, here is a one liner

Sub Sample()
    Name "C:\Temp2" As "C:\Temp3"
End Sub

Solution 3

Posting this for reference in the future. Using syntax from this answer I fleshed out a class I'd been writing.

I've created a directory manager class in VBA which may be relevant to anyone coming here in the future.

Private m_fso As New FileSystemObject

'
''requires reference to Microsoft Scripting Runtime

Public Function CopyAndRenameDirectory(ByVal p_copyDirectory As String, p_targetDirectory As String, p_newName As String) As Boolean

    'example
    'p_copyDirectory = "C:\temp\myGoingToBeCopiedDir
    'p_targetDirectory = "C:\Temp2"
    'p_newName = "AwesomeDir"

    'results:
    'myGoingToBeCopiedDir --> C:\Temp2\AwesomeDir

    CopyAndRenameDirectory = False

    p_targetDirectory = p_targetDirectory & "\"

    If Not Me.DoesPathExist(p_copyDirectory) Or Not Me.DoesPathExist(p_targetDirectory) Then
        Exit Function
    End If

    On Error GoTo errHandler
    m_fso.CopyFolder p_copyDirectory, p_targetDirectory & p_newName, True
    On Error GoTo 0

    Exit Function

errHandler:

    If PRINT_DEBUG Then Debug.Print "Error in CopyAndRenameDirectory: " & Err.Description
    Exit Function

End Function

Public Function CopyDirectory(ByVal p_copyDirectory As String, p_targetDirectory As String) As Boolean

    'example
    'p_copyDirectory = "C:\temp\myGoingToBeCopiedDir
    'p_targetDirectory = "C:\Temp2"
    'p_newName = ""

    'results:
    'myGoingToBeCopiedDir --> C:\Temp2\myGoingToBeCopiedDir

    CopyDirectory = False

    If Not Me.DoesPathExist(p_copyDirectory) Or Not Me.DoesPathExist(p_targetDirectory) Then
        Exit Function
    End If

    p_targetDirectory = p_targetDirectory & "\"

    On Error GoTo errHandler
    m_fso.CopyFolder p_copyDirectory, p_targetDirectory, True
    On Error GoTo 0

    Exit Function

errHandler:
    If PRINT_DEBUG Then Debug.Print "Error in CopyDirectory: " & Err.Description
    Exit Function

End Function

Public Function CreateFolder(ByVal p_path As String) As Boolean

    CreateFolder = True

    If Me.DoesPathExist(p_path) Then
        Exit Function
    Else
        On Error GoTo errHandler
        m_fso.CreateFolder p_path ' could there be any error with this, like if the path is really screwed up?
        Exit Function
    End If

errHandler:
        'MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
        CreateFolder = False
        Exit Function

End Function

Public Function DoesPathExist(ByVal p_path As String) As Boolean

    DoesPathExist = False
    If m_fso.FolderExists(p_path) Then DoesPathExist = True

End Function

Comments

[Siddharth Rout]

LOL. yes. You might want to see THIS

[enderland]

I would prefer to unsee that, to be honest ;)

[user2780436]

Sorry, maybe I didn't understand the question properly. I'll try explaining it again, and let me know if I'm out to lunch LOL... If you change the second parameter to different name then it works. This example would copy the folder called temp1 and rename it to temp2: objFSO.copyFolder "C:\temp1", "C:\temp2" true