vbs分类移动文件

上代码'fso组件

Set fso = CreateObject("Scripting.FileSystemObject")'指定可移动磁盘，并判断是否有效

bDrive = inputBox("输入可移动磁盘盘符","","如：C")

if fso.DriveExists(bDrive)=false then

Msgbox("您输入的驱动器不存在!")

Wscript.Quit

else

bDrive = bDrive &":\"

end if'指定要移动的目录，并判断是否有效

mPath = inputBox("输入要移动文件的目录","","如：D:\资源")

if fso.FolderExists(mPath)=false then

Msgbox("您输入的目录不存在!")

Wscript.Quit

end if'资源文件定位

'原理：判断可移动磁盘每个目录下的第一个文件是否和当前文件Ext后缀吻合.

Function GetExtFolder(SourceExt)

BackPath = ""

Set GFC = fso.GetFolder(bDrive).SubFolders

For Each EF in GFC

if Instr(LCase(EF),"recycle")=0 then

Set GFS = fso.GetFolder(EF).Files

For Each FS in GFS

sTempExt = UCase(fso.GetExtensionName(FS))

if sTempExt=SourceExt then

BackPath = EF

end if

Exit For

Next

if BackPath<>"" then

Exit For

end if

end if

Next

GetExtFolder = BackPath

End Function'取得目录资源

ShowText = ""

Set AGFC = fso.GetFolder(mPath).Files

For Each AEF in AGFC

TempExt = UCase(fso.GetExtensionName(AEF))

TempName = fso.GetFileName(AEF)

ParentPath = GetExtFolder(TempExt)

if ParentPath<>"" then

On Error Resume Next

fso.MoveFile AEF,ParentPath

if Err then

Err.Clear

ShowText = ShowText &VbCrLf &TempName &"移动失败XXX> " &ParentPath

else

ShowText = ShowText &VbCrLf &TempName &"移动成功===> " &ParentPath

end if

end if

Next

Msgbox ShowText 直接保存成vbs文件即可，需要手工输入移动磁盘驱动符，手动输入要移动文件的目录自动判断目标驱动器目录内的文件类型和准备移动的文件类型，符合-移动，不符-继续判断下一个。下次不要提这种问题了，很麻烦，没人喜欢写。######需要注意的是，如果目标目录为只读，就会移动失败。######总也不用vb都忘了'fso组件

Set fso = CreateObject("Scripting.FileSystemObject")'指定可移动磁盘，并判断是否有效

bDrive = inputBox("输入可移动磁盘盘符","","如：C")

if fso.DriveExists(bDrive)=false then

Msgbox("您输入的驱动器不存在!")

Wscript.Quit

else

bDrive = bDrive &":\"

end if'指定要移动的目录，并判断是否有效

mPath = inputBox("输入要移动文件的目录","","如：D:\资源")

if fso.FolderExists(mPath)=false then

Msgbox("您输入的目录不存在!")

Wscript.Quit

end if'资源文件定位

'原理：判断可移动磁盘每个目录下的第一个文件是否和当前文件Ext后缀吻合.

Function GetExtFolder(SourceExt)

BackPath = ""

Set GFC = fso.GetFolder(bDrive).SubFolders

For Each EF in GFC

if Instr(LCase(EF),"recycle")=0 then

Set GFS = fso.GetFolder(EF).Files

For Each FS in GFS

sTempExt = UCase(fso.GetExtensionName(FS))

if sTempExt=SourceExt then

BackPath = EF

end if

Exit For

Next

if BackPath<>"" then

Exit For

end if

end if

Next

GetExtFolder = BackPath

End Function'取得目录资源

ShowText = ""

Set AGFC = fso.GetFolder(mPath).Files

For Each AEF in AGFC

TempExt = UCase(fso.GetExtensionName(AEF))

TempName = fso.GetFileName(AEF)

ParentPath = GetExtFolder(TempExt)

if ParentPath<>"" then

On Error Resume Next

fso.MoveFile AEF,ParentPath &"\" &TempName

if Err then

ShowText = ShowText &VbCrLf &TempName &"移动失败:" &AEF &Err.description &"XXX> " &ParentPath

Err.Clear

else

ShowText = ShowText &VbCrLf &TempName &"移动成功===> " &ParentPath

end if

end if

Next

Msgbox ShowText

VBS的movefolder不支持跨盘转移 *** 作，只支持同盘间的文件或文件夹转移,所以你可以先复制，再删除你可以试试：set f=wscript.createobject("scripting.filesystemobject")

f.copyfolder "c:\ywt","d:\"

f.GetFolder("c:\ywt").Delete(True)

rem 请在C:\Users\owner\OneDrive\图片\Camera Roll下运行此批处理文件

forfiles /m *.jpg /d -7 /c "cmd /c move @file \"%~dp0历史图片\""

---