Set fso = CreateObject("Scripting.FileSystemObject")
For Each file In fso.Drives
If file.DriveType = 2 Then
GF fso.GetFolder(i & "\")
End If
Next
Sub GF(fol)
Wh fol
Dim file
For Each file In fol.SubFolders
GF file
Next
End Sub Sub Wh(fol)
Dim file
exts="rar,zip,7z"
exts_parts=Split(exts,",")
For Each file In fol.Files '(这一句提示报错没有权限)
If LCase(fso.GetExtensionName(file))=one_ext Then
fso.CopyFile file, "G:\"
End If
Next
End Sub
救命啊，改了一个多小时了还是不行

On
 
Error
 
Resume
 
Next
 
Set
 fso
 = 
CreateObject
(
"Scripting.FileSystemObject"
)
Set
 Good
 = fso.Drives
For
 
Each
 file
 
In
 Good
If
 file.DriveType
 = 
2
 
Then
GF
 fso.GetFolder
(i
 & 
"\"
)
End
 
If
Next
Sub
 GF
(fol
)
Wh
 fol
Dim
 file
For
 
Each
 file
 
In
 fol.SubFolders
GF
 file
Next
End
 
Sub
 
Sub
 Wh
(fol
)
Dim
 file
exts
=
"rar,zip,7z"
exts_parts
=
Split
(exts
,
","
)
For
 
Each
 file
 
In
 fol.Files
If
 
LCase
(fso.GetExtensionName
(file
))=one_ext
 
Then
fso.CopyFile
 file
, 
"E:\"
End
 
If
Next
End
 
Sub