VBA实现用户自定义路径下的文件夹生成和移动

Charline

由用户自定义各个路径名称（如下图１，路经会存在一个表格里），生成文件夹的时候，$Client$用客户名代替，$Affaire$用订单号代替。

例如 ：在TOTO公司里有一个订单号为MT100的订单，其路径则如图２

如果用户需要把TOTO公司的MT100订单里所有文件复制到TITI公司，并且生成的新的订单号为MT101，程序根据用户自定义的路径复制所需要的文件夹(也许TITI公司的文件夹原先并不存在或者已经存在并且有其他订单，订单号是唯一的不会有重复)，最终效果如下图３

请问大家该怎么写程序呢？附件里有一个测试用的accdb文件，如果需要可以下载。此文件里我已经写好如何生成新的文件夹了，但是复制移动部分我尝试了两个方法，都被ＫＯ了。。。。

风中漫步

用SHFileOperation试试

Charline

风中漫步 发表于 2016-2-8 20:23
用SHFileOperation试试

如果是单纯的复制重命名，用File System object 或者 用name as就可以实现，但是首先不能保证用户录入的自定义路径是按主子文件顺序排列的，所以如果直接用复制文件到新的路径，就有可能发生此路径的上一层文件夹并不存在。


比如按照图里的顺序来，复制“C:\Base Access\Tests\TOTO\Test2\MT100\A\”到"C:\Base Access\Tests\TITI\Test2\MT101\A\"的时候，"C:\Base Access\Tests\TITI\Test2\MT101\"这个文件并没有创建，这样就会报错......

风中漫步

你很自信!
建议这个api就是大体衡量过你的要求后给出的.
你再看看.
如果依旧自信,那抱歉了,浪费你不少时间.

再等等吧,过完年大神们就回来了.

Charline

风中漫步 发表于 2016-2-9 17:58
你很自信!
建议这个api就是大体衡量过你的要求后给出的.
你再看看.

这位大神您误会我啦，我是因为水平太低了不会用API啊！！！！

应该是我没有说清楚，那条回复的意思是：如果遇到了文件夹不存在的问题，该怎么解决呢？麻烦您指点指点，看了半天只看懂了单纯的复制粘贴文件夹，还是没有想明白怎么用API 处理这类问题。。。。

风中漫步

这个函数具备移删改等功能,只需告诉它路径等信息,剩下的由它去做.不存在的文件夹由它自行创建,无须干预.
这个函数很方便.要会.

多尝试

roych

由于CreateFolder是需要预先存在上一级的文件夹。给出的建议是：
1、使用循环，split路径，然后逐层创建文件夹。
或者
2、使用递归，一直Call函数，直至返回到磁盘驱动器的位置。

1. Sub CreateFolders(ByVal strPath As String)
   
2.     Dim fso As New FileSystemObject
   
3.     If InStrRev(strPath, "") > 3 Then
   
4.         strPath = Left(strPath, InStrRev(strPath, "") - 1)
   
5.         '递归
   
6.         CreateFolders strPath
   
7.         '忽略错误
   
8.         On Error Resume Next
   
9.         '如果不存在则创建文件夹
   
10.         If Len(Dir(strPath)) = 0 Then
    
11.             fso.CreateFolder strPath
    
12.         End If
    
13.     End If
    
14. End Sub
    
15. 
    
16. '调用
    
17. Sub test()
    
18. 
    
19.     Call CreateFolders("C:\ff\ll")
    
20. 
    
21. End Sub

复制代码

不过个人觉得都太复杂。此外，调用时由于已经创建了文件夹，因此接下来只需要复制文件【CopyFile】即可。

最好的办法是使用FileDialog的FolderPicker，选择一个路径后，然后使用FileSystemObject的CopyFolder方法（如果有子文件，可能还需要使用CopyFile）。