分类归档-将工作簿移动到对应的文件夹

原始文件：

要求：将文件夹1-1.xlsx、文件夹1-1.xlsx移动到文件夹1，依次类推

代码及说明：

Sub 移动文件()

    Dim MyFold As Object, MyFile As Object

    Dim ipath As String, TargetFolder As String

   

    '获取当前文件夹的路径

    ipath = ThisWorkbook.Path &''

   

    '建立文件系统对象变量MyFold

    Set MyFold =CreateObject('Scripting.FileSystemObject')

   

    '循环当前路径文件夹下的所有文件

    For Each MyFile InMyFold.GetFolder(ipath).Files

       

    '如果文件是.xlsx文件，则

        If MyFile.Name Like '*.xlsx'Then

        

         '获取该文件应属文件夹名称，需根据实际的工作表名称修改此句代码，Split()函数返回一个数组，其中包含基于分隔符分割的特定数量的值

            TargetFolder = ipath & '\' & Split(MyFile.Name, '-')(0)

           

            '文件夹是否存在则新建一个文件夹

            If NotMyFold.FolderExists(TargetFolder) Then

                MyFold.CreateFolderTargetFolder

            End If

           

            '文件夹中已经存在该文件则删除它

            If MyFold.FileExists(TargetFolder& '\' & MyFile.Name) Then

                MyFold.DeleteFile TargetFolder& '\' & MyFile.Name

            End If

            '将文件移动到所属文件夹

            MyFile.Move (TargetFolder &'\') 

        End If

    Next

    Set MyFold = Nothing

End Sub

----------------------------------------