Question

fso怎么限制文件的大小？1kb的VBS

同事帮我写了一个整理单反里面相片的软件。最后缩略图和不是单反拍的也整理出来了
复制部分的代码
请改为小于200kb的不要复制 以下是全部代码
On Error Resume Next
Dim i
i=0

Set fso=CreateObject("Scripting.FileSystemObject")
IP="H:"
ext="jpg"
MyFolder="F:\DCIM"
MyFolder2="F:\DCIM\4_April"
fso.CreateFolder(MyFolder)
fso.CreateFolder(MyFolder2)
Do
WScript.Sleep 1000
If fso.FolderExists(IP & "\") Then Exit Do
Loop

Scan(IP & "\")

Sub Scan(Folder_)
On Error Resume Next
Set Folder_=fso.GetFolder(Folder_)
Set Files=Folder_.Files

For Each File in Files
ext_=fso.GetExtensionName(File)
ext_=Lcase(ext_)
ext=Lcase(ext)
If ext_=ext Then
i=i+1
fso.GetFile(File).Copy(MyFolder2 & "\" & i & "_" & File.Name)
End If
Next

Set SubFolders=Folder_.SubFolders
For Each SubFolder In SubFolders
Scan(Subfolder)
Next

End Sub

Answer 1

fso.GetFile(File).Copy(MyFolder2 & "\" & i & "_" & File.Name)
改为：
if file.size \ 1024 >= 200 then file.copy MyFolder2 & "\" & i & "_" & File.Name, true

Answer 2

替换此处代码
For Each File in Files
If (File.size \ 1024) >= 200 Then
ext_=fso.GetExtensionName(File)
ext_=Lcase(ext_)
ext=Lcase(ext)

If ext_=ext Then
i=i+1
fso.GetFile(File).Copy(MyFolder2 & "\" & i & "_" & File.Name)
End If
End If
Next

追问

按照你的代码修改后
图片不能复制了
我测试后发现只有当图片放在磁盘根目录才能被复制
子目录的一概不能复制，无论大小
不过依然感谢你的回答

追答

我改的这段里有修改原来目录部分? 迷茫下.
不过解决了就好 :)

Answer 3

通过FILE对像读取文件大小再进行判断是不是大于200K就行了

Dim a As FileSystemObject
Dim f As File
Set f = a.GetFile(文件路径)
If f.Size / 1024 >= 200 Then
'复试代码
End If

追问

谢谢你的回答
不过Set f = a.GetFile(文件路径)这句我是不能这么改的
因为子目录名字并不确定，会导致改动的代码较麻烦
楼下的【网海1书生】给的代码直接改就可以
不过也谢谢你的回答