建立文件夹

半温

我真的麻了，这代码我改不动了，给我整不会了
Sub
  Dim r%, i%
  Dim arr
  Dim mypath$
  Dim filename
  Dim d As Object
  Set d = CreateObject("scripting.dictionary")
  Set d1 = CreateObject("scripting.dictionary")
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Worksheets("文件")
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("a2:c" & r)
    filename = .Range("B2")
  End With
  For i = 1 To UBound(arr)
    d(arr(i, 1)) = i
  Next
  For i = 2 To UBound(arr)
    ss = " "
    j = i
    Do While d.exists(arr(j, 3))
      ss = ss & "\" & arr(j, 2)
      j = d(arr(j, 3))
    Loop
    d1(ss) = ""
  Next
  mypath = "C:\Users\Administrator\Desktop" & "\"
  If Dir(mypath & arr(1, 2), vbDirectory) = "" Then
    MkDir mypath & arr(1, 2)
  End If
  kk = d1.keys
  For k = 0 To UBound(kk)
    brr = Split(kk(k), "\")
    ss = "C:\Users\Administrator\Desktop" & "\文件"
    For j = UBound(brr) To 1 Step -1
      ss = ss & "\" & brr(j)
    Next
    If Dir(ss, vbDirectory) = "" Then
      MkDir ss
    End If
  Next
  MsgBox "文件已经建立完毕!"
End Sub

半温

我想干嘛，就是B2是个不确定的文件名，我想建立B2文件名的文件夹在桌面上，剩下的子文件夹依次存放到这个总文件夹内

半温

没人帮我么

rarnma

这个应该去VBA区问啊，那里代码大佬多。

半温

rarnma 发表于 2022-3-16 14:24
这个应该去VBA区问啊，那里代码大佬多。

哎，没事，我这个代码我勉强用用