求助，复制文件

虔诚的小草

求助大神，简要说明下就是要将各文件夹下面的特定文件复制出来，各层级下面有文件或者没有。具体详见附件。昨天学习了挺多关于FSO的使用的贴，还是没掌握，结果要么不齐全，要么报错。请求各位大佬指导下，谢谢。

ykcbf1100

只完成了第1、2步，后面几步没看明白，你自己弄下吧。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.5.17
   
2.     Dim fns As New Collection
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         .Title = "请选择文件夹"
   
5.         .InitialFileName = ThisWorkbook.Path & ""
   
6.         If .Show = -1 Then
   
7.             p = .SelectedItems(1) & ""
   
8.         End If
   
9.     End With
   
10.     Set fso = CreateObject("Scripting.FileSystemObject")
    
11.     Set sh = ThisWorkbook.Sheets("操作台")
    
12.     Set ff = fso.GetFolder(p)
    
13.     getFiles ff, fns, fso
    
14.     ReDim brr(1 To 1000, 1 To 1)
    
15.     For Each f In fns
    
16.         m = m + 1
    
17.         brr(m, 1) = f(1)
    
18.     Next
    
19.     With sh
    
20.         .[h2:h1000] = ""
    
21.         .[h2].Resize(m, 1) = brr
    
22.     End With
    
23.     MsgBox "OK！"
    
24. End Sub

复制代码

虔诚的小草

ykcbf1100 发表于 2024-5-17 08:50
只完成了第1、2步，后面几步没看明白，你自己弄下吧。

感谢大佬，你完成的是第一步。。。意思是将***清单.xls/xlsx的文件都复制出来，统一放到指定或自建的文件夹中。****清单-副本.xls这样的格式的文件也不复制。然后再将复制出来的文件进行按规格批量改名。

ykcbf1100

虔诚的小草 发表于 2024-5-17 09:02
感谢大佬，你完成的是第一步。。。意思是将***清单.xls/xlsx的文件都复制出来，统一放到指定或自建的文件 ...

最重要的一步， 文件名获取已经完成，其它都简单的，你自己搞下就行。

fanyoulin

我给你做了完整的递归函数，并罗列了各种应用方法。稍有缺陷的是需要定义一个很大的静态数组，可能会浪费一点内存，你可根据实际的数据量调整数组的大小。这个方法的好处是灵活多变，适应性强；

但没做复制部分，你自己加上就行了；

虔诚的小草

ykcbf1100 发表于 2024-5-17 09:10
最重要的一步， 文件名获取已经完成，其它都简单的，你自己搞下就行。

不简单啊大佬。我复制文件总是报错。。。。弄得我头疼。

ykcbf1100

虔诚的小草 发表于 2024-5-17 09:23
不简单啊大佬。我复制文件总是报错。。。。弄得我头疼。

你把述求搞简单点，就上个文件复制。你要求多了，别人完成起来费时。

虔诚的小草

fanyoulin 发表于 2024-5-17 09:10
我给你做了完整的递归函数，并罗列了各种应用方法。稍有缺陷的是需要定义一个很大的静态数组，可能会浪费一 ...

复制文件这是最重要的一步啊，我复制文件总是不成功。也是用的其它贴的递归方式，总会报错，偶尔成功。

虔诚的小草

ykcbf1100 发表于 2024-5-17 09:26
你把述求搞简单点，就上个文件复制。你要求多了，别人完成起来费时。

其实主要就是为了将里面符合条件的复制出来统一到一个文件夹中。其它要求我可以单独做个dir获取文件名。我就是复制文件出来到指定文件夹中，总是各种报错，参数溢出等。大佬可以自建个文件夹out放在桌面，将符合要求的文件统一复制到out中?