|
- Private dicDir As Object
- Sub 建立多级文件夹()
- Dim vData As Variant, nLevel As Long, nRow As Long
-
- Set dicDir = CreateObject("Scripting.Dictionary")
- vData = Sheet1.UsedRange.Value
- For nLevel = 1 To UBound(vData, 2)
- If Not dicDir.Exists(nLevel) Then Set dicDir(nLevel) = CreateObject("Scripting.Dictionary")
- For nRow = 2 To UBound(vData)
- If vData(nRow, nLevel) <> "" Then dicDir(nLevel)(vData(nRow, nLevel)) = 0
- Next
- Next
- CreateDir 1, UBound(vData, 2), ThisWorkbook.Path
- End Sub
- Function CreateDir(ByVal nLevel As Long, ByVal nMaxLevel As Long, ByVal sPath As String)
- Dim vName As Variant, sNewPath As String, bNew As Boolean
- For Each vName In dicDir(nLevel).Keys
- sNewPath = Dir(sPath & "" & vName, vbDirectory)
- bNew = sNewPath = ""
- If Not bNew Then bNew = GetAttr(sPath & "" & vName) And vbDirectory <> vbDirectory
- If bNew Then MkDir sPath & "" & vName
- If nLevel < nMaxLevel Then CreateDir nLevel + 1, nMaxLevel, sPath & "" & vName
- Next
- End Function
复制代码 |
|