Excel VBA之FSO-2.3文件夹的移动

前景提要

我们之前接触了如何通过FSO来实现文件夹的复制操作，此操作需要注意的一点就是如果当前文件夹中有历史版本的同名文件夹的话，他会直接覆盖原来的数据，如果需要保存历史数据的话，在使用之前最好先做好备份，今天我们继续了解FSO和文件夹的操作，复制完成之后，我们可能还需要将原来的数据删除，这样才不会占用空间，我能不能直接移动文件夹，类似剪切这样子呢，这样我就不用再去删除数据，FSO可以做到这一点的。

思路

我们先还是首先来确定下思路，移动文件夹和文件夹的复制的思路是差不多的，文件夹的两个路径肯定是必须的，这里我们可以尝试结合之前学过的fileexist等方法，判断下文件夹是否存在，因为移动文件夹的话，如果出现同名文件夹会报错的，这里要记得判断下。

上代码

Sub test()Dim pathn$, fs As Object, FileName$, NewString$, s$, OldString$Set fs = CreateObject("Scripting.FileSystemObject") '创建FSOWith Application.FileDialog(msoFileDialogFolderPicker) '调用文件选择框 .Title = "请选择要复制的文件夹" '选择框的名字，人性化 If .Show = -1 Then OldString = .SelectedItems(1) '文件夹的路径 FileName = Split(OldString, "\")(UBound(Split(OldString, "\"))) '通过拆分和最大下标的方式的活文件名 End IfEnd WithWith Application.FileDialog(msoFileDialogFolderPicker) .Title = "请选择要粘贴的位置" If .Show = -1 Then s = .SelectedItems(1) '获得要粘贴的文件夹路径 NewString = s & "\" & FileName '将上面的路径和前面得到的文件名合并，构造要粘贴的文件夹的完整路径 End IfEnd WithIf fs.FolderExists(NewString) Then fs.DeleteFolder (NewString) fs.MoveFolder OldString, NewString MsgBox "复制成功！" Else fs.MoveFolder OldString, NewString MsgBox "复制成功！"End IfSet fs = Nothing '释放FSOEnd Sub

效果如图：

执行操作前：

原文件夹

目标文件夹

这里没有文件夹

执行操作之后：

目标文件夹内

而原文件夹内

很明显，代码达到了我们的要求。

代码解析

前面一部分的代码和昨天分享的内容都是一样的，基本上没有变动，只是更改了部分路径而已，如果有不太清楚的地方，大家可以看看昨天的文章回顾下

然后就是本次的新知识点了，前面做了那么多的准备工作，都是为了这一步，FSO文件夹的移动

fs.MoveFolder OldString, NewString

原来的路径在前，新路径再后。

这里说明一点：移动文件夹的操作虽然等同于剪切文件夹这样的操作，但是它有很大的局限性，就是他只能在同盘符之前进行操作移动，不能跨盘符，就是说原始文件再D盘，我只能在D盘范围内执行移动，不能移动到C盘，E盘等其他盘，这点在使用一定要注意，如果跨盘符移动的话，会提示你权限不够等，当初小编也是卡在这里，找了好多资料才看这样的解释的。大家要牢记，跨盘符的话，还是使用复制的操作吧。而且移动的操作，需要判断同名文件夹是否存在，存在的话，还需要删除才可以执行移动的操作，相对与复制文件夹来说，有很大的局限性和弊端，不过根据使用场合和场景的不同，大家可以根据自己的需求灵活使用。

完整代码加注释

Sub test()Dim pathn$, fs As Object, FileName$, NewString$, s$, OldString$Set fs = CreateObject("Scripting.FileSystemObject") '创建FSOWith Application.FileDialog(msoFileDialogFolderPicker) '调用文件选择框 .Title = "请选择要复制的文件夹" '选择框的名字，人性化 If .Show = -1 Then OldString = .SelectedItems(1) '文件夹的路径 FileName = Split(OldString, "\")(UBound(Split(OldString, "\"))) '通过拆分和最大下标的方式的活文件名 End IfEnd WithWith Application.FileDialog(msoFileDialogFolderPicker) .Title = "请选择要粘贴的位置" If .Show = -1 Then s = .SelectedItems(1) '获得要粘贴的文件夹路径 NewString = s & "\" & FileName '将上面的路径和前面得到的文件名合并，构造要粘贴的文件夹的完整路径 End IfEnd WithIf fs.FolderExists(NewString) Then '判断同名文件夹是否存在 fs.DeleteFolder (NewString) '存在的话先删除 fs.MoveFolder OldString, NewString '在执行移动的操作 MsgBox "复制成功！" Else fs.MoveFolder OldString, NewString '不存在可以直接移动 MsgBox "复制成功！"End IfSet fs = Nothing '释放FSOEnd Sub

总结

==========================================================================

今天的知识点主要是通过FSO来移动文件夹的，不过相对于之前我们学习的复制文件夹的方法来说，此方法存在很多的弊端和局限性，对于小编这样很强调代码的通用性的人来说，移动文件夹是一个并不太实用的功能，大家在使用的时候，要牢记使用场景，同盘符，同盘符，同盘符，重要的事情说三遍。现在的电脑配置都比较的好，应该不存在内存不足的情况，还是建议大家条件允许的情况下尽量使用复制的功能比较好

==========================================================================

本人已经打算长期分享一些网络搜集的各种VBA知识，如果大家有问题也可以提出来共同解决，一起进步，毕竟VBA的世界还是很大的。