vbs脚本：MoveFolder

最新推荐文章于 2024-04-21 15:59:47 发布

bj_wellcome

最新推荐文章于 2024-04-21 15:59:47 发布

阅读量441

点赞数

CC 4.0 BY-SA版权

分类专栏： VB &amp; VBS 文章标签：脚本

本文链接：https://blog.youkuaiyun.com/bj_wellcome/article/details/5797462

VB & VBS 专栏收录该内容

17 篇文章

订阅专栏

本文提供了一个使用VBA实现文件夹移动的示例代码。该代码详细展示了如何检查源文件夹和目标文件夹的存在状态及权限，并通过复制和删除操作完成文件夹的移动。此外还介绍了代码中错误处理的方法。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Rem :  ===========  将文件夹 folder1 移动到文件夹 folder2 中
Rem :  ===========  folder1必须存在
Rem :  ===========  folder2必须存在且属性不能为只读
Rem :  ===========  foler2中不能存在与folder1同名的文件或文件夹
Sub MoveFolder( folder1, folder2 )
	Dim f1, f2
	f1 = folder1
	f2 = folder2
	If Right(folder1,1) = "/" Then f1 = Left(folder1,Len(folder1) -1 )
	If Right(folder2,1) = "/" Then f2 = Left(folder2,Len(folder2) -1 )
	If fso.folderexists(f1)=False Then Err.Raise vbObjectError+128, "MoveFolder", "Folder : " & f1 & " does not exist"
	If fso.folderexists(f2)=False Then Err.Raise vbObjectError+128, "MoveFolder", "Folder : " & f2 & " does not exist"
	
	f = f2 & "/" & fso.GetBaseName(f1)
	If fso.fileexists(f) = True Or fso.folderexists(f) = True Then
		Err.Raise vbObjectError+128, "MoveFolder", f & " already exists"
		Exit Sub
	End If
	
	Dim errMsg
	On Error Resume Next
	Rem  ======  code begin
'	fso.MoveFolder f1, f	' 不明白为什么会出错
	fso.CopyFolder f1, f2 & "/", False
	fso.DeleteFolder f1, True
	Rem  ======  code end
	If Err.Number <> 0 Then
		errMsg = Err.Description
		On Error Goto 0
		Err.Raise vbObjectError+128, "MoveFolder", errMsg & vbNewLine & _
								"                folder1:" & vbTab & folder1 & vbNewLine & _
								"                folder2:" & vbTab & folder2
		Exit Sub
	End If
	End Sub