根据日期建立三级目录

ning84

1. Sub DictFileToFolder()
   
2.     Dim Fso As New FileSystemObject, oFild As Folder
   
3.         Set Fso = New FileSystemObject
   
4.    
   
5.     Dim Dic As New Dictionary
   
6.         Set Dic = New Dictionary
   
7.     Dim Rng As Range, oRng As Range
   
8.     Dim Str, ii, jj, Cc, Kk
   
9.         Set Rng = Sheet1.Cells(4, 1).CurrentRegion
   
10.         Debug.Print Rng.Address
    
11.         For ii = 1 To Rng.Rows.Count
    
12.             Str = Format(Rng(ii, 1), "yyyy年mm月dd日")
    
13.             Dic(Str) = ""
    
14.         Next ii
    
15.         'Stop
    
16.     Dim Arr()
    
17.         ReDim Arr(Dic.Count - 1, 2)
    
18.         For ii = 0 To Dic.Count - 1
    
19.              Arr(ii, 0) = "" & Format(Dic.Keys(ii), "yyyy年")
    
20.              Arr(ii, 1) = Arr(ii, 0) & "" & Format(Dic.Keys(ii), "yyyy年mm月")
    
21.              Arr(ii, 2) = Arr(ii, 1) & "" & Dic.Keys(ii)
    
22.         Next ii
    
23.     Set Rng = Sheet2.Cells(3, 1).Resize(49, 3)
    
24.     Rng = Arr
    
25.     Stop
    
26.     For ii = 0 To UBound(Arr)
    
27.         For jj = 0 To 2
    
28.         
    
29.             If Fso.FolderExists(ThisWorkbook.Path & Arr(ii, jj)) = False Then
    
30.                  Fso.CreateFolder ThisWorkbook.Path & Arr(ii, jj)
    
31.             End If
    
32.         
    
33.         Next jj
    
34.     Next ii
    
35.     Stop
    
36.         
    
37.         
    
38. End Sub
    
39. 
    

复制代码

ykcbf1100

发现楼主喜欢自己出题自己解，挺好

shiruiqiang

非常不错，代码和思路能学习一下。希望能有附件

wanghan519

要不就直接构造以斜杠分隔的字符串，直接传给mkdir -p

zpy2

wanghan519 发表于 2024-1-30 10:35
要不就直接构造以斜杠分隔的字符串，直接传给mkdir -p

学习一下。。