问如何将文件批量移动到名称相似的文件夹？

EN

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