|
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp" (ByVal PathName As String) As Long
Option Explicit
Sub test()
Dim ar(), r&, strFileName$, strPath1$, strPath2$
Application.ScreenUpdating = False
strPath2 = ThisDocument.Path & "\员工档案汇总\"
strPath1 = ThisDocument.Path & "\员工档案\"
strFileName = Dir(strPath1 & "*.doc*")
Do Until strFileName = ""
If strFileName Like "*.doc*" Then
r = r + 1
ReDim Preserve ar(1 To 3, 1 To r)
ar(1, r) = strPath1 & strFileName
ar(2, r) = strPath2 & Left(strFileName, InStrRev(strFileName, ".") - 1) & "\"
MakeSureDirectoryPathExists ar(2, r)
Name ar(1, r) As ar(2, r) & strFileName
End If
strFileName = Dir
Loop
Application.ScreenUpdating = True
Beep
End Sub
|
评分
-
1
查看全部评分
-
|