|
Sub 分类()
Application.ScreenUpdating = False
Dim ar As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
lj = ThisWorkbook.Path & "\"
With Sheets("sheet1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "数据表为空!": End
ar = .Range("a1:c" & r)
End With
For i = 2 To UBound(ar)
If Trim(ar(i, 3)) <> "" Then
wjj = lj & ar(i, 3)
If Not fso.folderexists(wjj) Then fso.CreateFolder wjj
wj = lj & "照片\" & ar(i, 1) & ".jpg"
If Dir(wj) <> "" Then
'fso.movefile wj, wjj & "\" ''移动用这句
fso.copyfile wj, wjj & "\" ''拷贝用这句
End If
End If
Next i
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|