求大侠帮忙写一个代码，就是根据表A列内容建立文件夹，再根据B列内容查找指定文件...

gd555555

求大侠帮忙写一个代码，根据表A列内容建立文件夹到指定文件夹（e:\cd）下，再根据B列内容查找指定文件夹(包含子文件夹）（e:\ab）的文件然后复制到对应A列内容建立的文件夹里。 求助.rar (8.51 KB, 下载次数: 64)

2017-2-2 15:08 上传

点击文件名下载附件

gd555555

请各位高手帮帮忙，谢谢了！

kzg2013

Sub COPYFILES()
Dim FSO As Object
Dim SFD As Object
Dim SSFD As Object
Dim FL As Object
Set FSO = CreateObject("SCRIPTING.FILESYSTEMOBJECT")
For K = 1 To Range("A1048576").End(xlUp).Row
If Not FSO.FOLDEREXISTS("E:\CD\" & Cells(K, 1)) Then'建立文件夹
FSO.CREATEFOLDER ("E:\CD\" & Cells(K, 1))

End If
Next K


Set FD = FSO.GETFOLDER("E:\AB")

        For K = 1 To Range("A1048576").End(xlUp).Row
      For Each FL In FD.Files 'E:\AB"‘主文件夹

         If FSO.GetFileName(FL) = Cells(K, 2) Then
           FSO.COPYFILE FL, "E:\CD\" & Cells(K, 1) & "\"
         End If
       Next FL
          Next K
        Set FL = Nothing


       Set SFD = FD.SubFolders '子文件夹

           For K = 1 To Range("A1048576").End(xlUp).Row

              For Each SSFD In SFD
                     For Each FL In SSFD.Files

                       If FSO.GetFileName(FL) = Cells(K, 2) Then
                        FSO.COPYFILE FL, "E:\CD\" & Cells(K, 1) & "\"
                       End If
                    Next FL
                Next SSFD
          Next K




     MsgBox "OK"

End Sub

gd555555

太感谢你了

gd555555

能否加入有个别文件找不到时最后给个提示？

蓝桥玄霜

请见代码。

kzg2013

If FSO.GetFileName(FL) = Cells(K, 2) Then
               Cells(K, 2).Interior.ColorIndex = 3 '
                       Cells(K, 2).Interior.ColorIndex = 3
                        '添加这一句，如果存在，则标记为3（红色）
                        ’循环后，没有标记的则不存在
           FSO.COPYFILE FL, "E:\CD\" & Cells(K, 1) & "\"
         End If
       Next FL
          Next K
        Set FL = Nothing
        
        
       Set SFD = FD.SubFolders '子文件夹寻找
           
           For K = 1 To Range("A1048576").End(xlUp).Row
     
              For Each SSFD In SFD
                     For Each FL In SSFD.Files
         
                       If FSO.GetFileName(FL) = Cells(K, 2) Then
                         Cells(K, 2).Interior.ColorIndex = 3
                        '添加这一句，如果存在，则标记为3（红色）
                        ’循环后，没有标记的则不存在

gd555555

感谢各位老师的帮助，谢谢！

gd555555

六楼的程序运行不了，老师

LMY123

根据A列创建文件夹，并将对应B列的文件分别复制到A列生成的文件夹中