前景提要
我们之前接触了如何通过FSO来实现文件夹的复制操作，此操作需要注意的一点就是如果当前文件夹中有历史版本的同名文件夹的话，他会直接覆盖原来的数据，如果需要保存历史数据的话，在使用之前最好先做好备份，今天我们继续了解FSO和文件夹的操作，复制完成之后，我们可能还需要将原来的数据删除，这样才不会占用空间，我能不能直接移动文件夹，类似剪切这样子呢，这样我就不用再去删除数据，FSO可以做到这一点的。
思路
我们先还是首先来确定下思路，移动文件夹和文件夹的复制的思路是差不多的，文件夹的两个路径肯定是必须的，这里我们可以尝试结合之前学过的fileexist等方法，判断下文件夹是否存在，因为移动文件夹的话，如果出现同名文件夹会报错的，这里要记得判断下。
上代码
Sub test()
Dim pathn$, fs As Object, FileName$, NewString$, s$, OldString$
Set fs = CreateObject("Scripting.FileSystemObject") '创建FSO
With Application.FileDialog(msoFileDialogFolderPicker) '调用文件选择框
.Title = "请选择要复制的文件夹" '选择框的名字，人性化
If .Show = -1 Then
OldString = .SelectedItems(1) '文件夹的路径
FileName = Split(OldString, "\")(UBound(Split(OldString, "\"))) '通过拆分和最大下标的方式的活文件名
End If
End With
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "请选择要粘贴的位置"
If .Show = -1 Then
s = .SelectedItems(1) '获得要粘贴的文件夹路径
NewString = s & "\" & FileName '将上面的路径和前面得到的文件名合并，构造要粘贴的文件夹的完整路径
End If
End With
If fs.FolderExists(NewString) Then
fs.DeleteFolder (NewString)
fs.MoveFolder OldString, NewString
MsgBox "复制成功！"
Else
fs.MoveFolder OldString, NewString
MsgBox "复制成功！"
End If
Set fs = Nothing '释放FSO
End Sub
效果如图：
执行操作前：
image.png
目标文件夹
image.png
这里没有文件夹
执行操作之后：
image.png
而原文件夹内
image.png
很明显，代码达到了我们的要求。
代码解析
前面一部分的代码和昨天分享的内容都是一样的，基本上没有变动，只是更改了部分路径而已，如果有不太清楚的地方，大家可以看看昨天的文章回顾下
然后就是本次的新知识点了，前面做了那么多的准备工作，都是为了这一步，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") '创建FSO
With Application.FileDialog(msoFileDialogFolderPicker) '调用文件选择框
.Title = "请选择要复制的文件夹" '选择框的名字，人性化
If .Show = -1 Then
OldString = .SelectedItems(1) '文件夹的路径
FileName = Split(OldString, "\")(UBound(Split(OldString, "\"))) '通过拆分和最大下标的方式的活文件名
End If
End With
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "请选择要粘贴的位置"
If .Show = -1 Then
s = .SelectedItems(1) '获得要粘贴的文件夹路径
NewString = s & "\" & FileName '将上面的路径和前面得到的文件名合并，构造要粘贴的文件夹的完整路径
End If
End With
If fs.FolderExists(NewString) Then '判断同名文件夹是否存在
fs.DeleteFolder (NewString) '存在的话先删除
fs.MoveFolder OldString, NewString '在执行移动的操作
MsgBox "复制成功！"
Else
fs.MoveFolder OldString, NewString '不存在可以直接移动
MsgBox "复制成功！"
End If
Set fs = Nothing '释放FSO
End Sub
网友评论