3

VB/VBA (またはネイティブ VBA 呼び出しだと思います) でFileSystemObjectを使用すると、次のことができます。

  1. フォルダをコピー
  2. フォルダの名前を変更

したがって、次のようなものです：

mFSO.CopyAndRename(targetFolder, copyDirectory, copyFolderName)

私は基本的にこれを自分で行いましたが、上記（およびCopyFolderメソッド）のようなよりクリーンなメソッド呼び出しを好みます。これは多くのコードと多くの潜在的な障害点のようです...

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

3 に答える 3

5

実際、Scripting.FileSystemObject には CopyFolder というメソッドがあります。次のように、コピーと名前変更の両方を 1 つのステップで実行するために使用できます。

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

私はここでコードを見つけました: http://vba-tutorial.com/copy-a-folder-and-all-of-its-contents/

これがあなたの質問に答えることを願っています。

于 2013-09-24T01:47:47.253 に答える
1

今後の参考のために投稿します。この回答の構文を使用して、私が書いていたクラスを具体化しました。

VBA でディレクトリ マネージャー クラスを作成しました。これは、将来ここに来る人に関連する可能性があります。

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
于 2013-09-24T14:13:28.290 に答える
1

私のお気に入り: SHFileOperation API

これにより、移動中のフォルダーを視覚的に表現することもできます。

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

フォルダーの名前を変更するためのワンライナーは次のとおりです

Sub Sample()
    Name "C:\Temp2" As "C:\Temp3"
End Sub
于 2013-09-23T19:41:17.070 に答える