|
楼主 |
发表于 2024-2-13 11:25
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
简单实用的方法不用,编程纯属做无用功。
- Sub TraverseFileDictFolder()
- Dim Fso As FileSystemObject, oFile As File, oFolder As Folder
- Set Fso = New FileSystemObject
- Dim PathName, Str, ii As Integer, jj, Cc, Kk
-
- Dim Dic As Dictionary
- Set Dic = New Dictionary
- PathName = ThisWorkbook.Path & "\temp"
- ''
- Set oFolder = Fso.GetFolder(PathName)
- ReDim Arr(oFolder.Files.Count - 1) As File
- For Each oFile In oFolder.Files
- Set Arr(ii) = oFile '.DateLastModified
- ii = ii + 1
- Next oFile
- DateCreate3Directionary Fso, Arr
- MoveFileToFolder Fso, Arr
- End Sub
- Function MoveFileToFolder(Fso As FileSystemObject, Arr)
- Dim Str
- Dim oFile As File
- For ii = 0 To UBound(Arr)
- Set oFile = Arr(ii)
- Str = ThisWorkbook.Path
- Str = Str & "" & Format(oFile.DateLastModified, "yyyy年")
- Str = Str & "" & Format(oFile.DateLastModified, "yyyy年mm月")
- Str = Str & "" & Format(oFile.DateLastModified, "yyyy年mm月dd日")
- Str = Str & "" & oFile.Name
- Debug.Print Str
-
- If Fso.FileExists(Str) = False Then
-
- oFile.Move Str
-
- End If
-
- Next ii
- End Function
- ''
- Function DateCreate3Directionary(Fso As FileSystemObject, oArr)
- Dim Dic As Dictionary
- Dim oFile As File
- Dim Str
- Set Dic = New Dictionary
-
- For ii = 0 To UBound(oArr)
-
- Str = Format(oArr(ii).DateLastModified, "yyyy年mm月dd日")
- Dic(Str) = ""
- Next ii
- ''
- Dim Arr
- ReDim Arr(Dic.Count - 1, 2)
-
- For ii = 0 To Dic.Count - 1
- Arr(ii, 0) = "" & Format(Dic.Keys(ii), "yyyy年")
- Arr(ii, 1) = Arr(ii, 0) & "" & Format(Dic.Keys(ii), "yyyy年mm月")
- Arr(ii, 2) = Arr(ii, 1) & "" & Dic.Keys(ii)
-
- Next ii
- ''
- For ii = 0 To UBound(Arr)
- For jj = 0 To 2
-
- If Fso.FolderExists(ThisWorkbook.Path & Arr(ii, jj)) = False Then
- Fso.CreateFolder ThisWorkbook.Path & Arr(ii, jj)
- End If
-
- Next jj
- Next ii
-
- End Function
-
-
复制代码
|
|