Vba 如何将文件批量移动到类似命名的文件夹？

我正在尝试将文件批量移动到具有新名称的新文件夹中。例如，我想从以下位置移动所有文件：

C:\cat\
C:\狗\

致：

C:\test\cat-1234\
C:\test\dog-2477\

我有大约400个文件夹，我想这样移动

---

目标文件夹将始终包含原始文件夹名称。

我认为没有大容量移动，即使您编写批处理程序，操作系统也只允许您一次执行一个文件。

是的，您可以将文件从一个文件夹复制到另一个文件夹。您可以使用API

SHFileOperation

：）它还将提供您在windows将文件从一个文件夹复制到另一个文件夹时看到的动画外观：）以下是一个示例。请根据您的实际需要进行修改

Option Explicit

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

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 Const FO_COPY = &H2

Sub Sample()
    Dim FilePath1 As String, FilePath2 As String

    FilePath1 = "C:\cat"
    FilePath2 = "C:\test\cat-1234"

    '~~> Usage ~~> CopyFolder(From,To)
    '~~> Example ~~> CopyFolder("C:\Temp\1","C:\Temp\2")
    If CopyFolder(FilePath1, FilePath2) Then
        MsgBox "Copied"
    Else
        MsgBox "Not copied"
    End If
End Sub

Private Function CopyFolder(ByVal sFrom As String, _
ByVal sTo As String) As Boolean
    Dim SHFileOp As SHFILEOPSTRUCT
    On Error GoTo Whoa
    CopyFolder = False
    With SHFileOp
        .wFunc = FO_COPY
        .pFrom = sFrom
        .pTo = sTo
    End With
    SHFileOperation SHFileOp
    CopyFolder = True
    Exit Function
Whoa:
    MsgBox "Following error occurd while copying folder " & sFrom & vbCrLf & _
    Err.Description, vbExclamation, "Error message"
End Function

---

您想使用VBA移动文件的原因是什么？这可能不是最合适的语言。@assylias这样做的合适语言是什么？我想使用VBA的唯一原因是，如果出现问题，我可以调试代码。我想PowerShell脚本可能是最好的，但我对PS不是很熟悉。我也不熟悉PS，但我会认为这确实是一个shell脚本可以做得很好的事情。