excel vba基于部分文件名移动文件

Sub MoveFilesBasedOnPartialFileName()
    Dim SourceFolder As String
    Dim DestinationFolder As String
    Dim FileExtension As String
    Dim FileName As String
    Dim File As Variant
    
    ' 设置源文件夹路径
    SourceFolder = "C:\SourceFolder\"
    
    ' 设置目标文件夹路径
    DestinationFolder = "C:\DestinationFolder\"
    
    ' 设置文件扩展名
    FileExtension = ".xlsx"
    
    ' 遍历源文件夹中的所有文件
    FileName = Dir(SourceFolder & "*" & FileExtension)
    Do While FileName <> ""
        ' 判断文件名中是否包含指定的部分
        If InStr(FileName, "部分文件名") > 0 Then
            ' 移动文件到目标文件夹
            FileCopy SourceFolder & FileName, DestinationFolder & FileName
            Kill SourceFolder & FileName ' 可选：删除源文件
        End If
        FileName = Dir
    Loop
    
    MsgBox "文件移动完成！"
End Sub