Dim ary(),arr(), m As Integer, mm As Integer, drr()
Sub 分类文档()
Dim myPath$, myFile$, d AsObject, a, p, temp$, temp3$, k, t, i&, j&
Set wb = ThisWorkbook
myPath = ThisWorkbook.Path &"\"
myFile = Dir(myPath &"*.doc")
Set d = CreateObject("scripting.dictionary")
Do While myFile <>""
IfmyFile <> ThisWorkbook.Name Then
If InStr(myFile, ".") Then
a = Split(myFile, ".")
temp = a(0) '分离出文件名
temp3 = Left(temp,4) '以文件名前4位作为子目录名
End If
If Notd.Exists(temp3) Then
d(temp3) = myFile
Else
d(temp3) = d(temp3) & Chr(9) & myFile
End If
End If
myFile = Dir
Loop
k = d.keys
t = d.items
For i = 0 To d.Count - 1
IfDir(myPath & k(i), 16) = "" Then MkDir myPath & k(i)
a =Split(t(i), Chr(9))
For j =0 To UBound(a)
If Len(Dir(myPath & k(i) & "\" & a(j))) Then KillmyPath & k(i) & "\" & a(j)
Name myPath & a(j) As myPath & k(i) & "\" &a(j)
Next
Next
MsgBox "分类完毕"
End Sub
Sub 分类文档()
Dim myPath$, myFile$, d AsObject, a, p, temp$, temp3$, k, t, i&, j&
Set wb = ThisWorkbook
myPath = ThisWorkbook.Path &"\"
myFile = Dir(myPath &"*.doc")
Set d = CreateObject("scripting.dictionary")
Do While myFile <>""
IfmyFile <> ThisWorkbook.Name Then
If InStr(myFile, ".") Then
a = Split(myFile, ".")
temp = a(0) '分离出文件名
temp3 = Left(temp,4) '以文件名前4位作为子目录名
End If
If Notd.Exists(temp3) Then
d(temp3) = myFile
Else
d(temp3) = d(temp3) & Chr(9) & myFile
End If
End If
myFile = Dir
Loop
k = d.keys
t = d.items
For i = 0 To d.Count - 1
IfDir(myPath & k(i), 16) = "" Then MkDir myPath & k(i)
a =Split(t(i), Chr(9))
For j =0 To UBound(a)
If Len(Dir(myPath & k(i) & "\" & a(j))) Then KillmyPath & k(i) & "\" & a(j)
Name myPath & a(j) As myPath & k(i) & "\" &a(j)
Next
Next
MsgBox "分类完毕"
End Sub