如何用vba生成文件夹

syaoraney

求助各位
如何做出一个弹出窗口，选择地址，
比如选择了图片里的G盘，然后生成一个项目日期的220420的文件夹，再在该文件夹下生成A列的文件夹，
感谢~

limonet

代码审核中

limonet

Sub mkdirRRR()
    Dim i%, Pah$
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then Path = .SelectedItems(1) & "\" Else Exit Sub
    End With
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        mkdir Path & Cells(i, "A")
    Next i
End Sub

fzxba

Sub test1()
  Dim p As String
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = ThisWorkbook.Path
    If .Show Then p = .SelectedItems(1) Else Exit Sub
  End With
  If Right(p, 1) <> "\" Then p = p & "\"
  Dim ar, i As Long
  ar = Range("A1").CurrentRegion.Value
  With CreateObject("Scripting.FileSystemObject")
    p = p & ar(1, 3) & "\"
    If Not .FolderExists(p) Then .CreateFolder p
    For i = 1 To UBound(ar)
      If Len(ar(i, 1)) Then
        If Not .FolderExists(p & ar(i, 1)) Then .CreateFolder p & ar(i, 1)
      End If
    Next
  End With
  Beep
End Sub

zldccmx

zldccmx

详见附件！
双击单元格启动功能

lcluck2002

VBA新建文件夹20221207.zip

gwjkkkkk

Sub TEST()
   Dim p$, arr, i&, strFolder As Object

   If [C1] = "" Then MsgBox "项目日期为空请，请检查!", vbExclamation: Exit Sub
   Set strFolder = CreateObject("Shell.Application").BrowseForFolder(0, "GetFolder", 0)
   If Not strFolder Is Nothing Then p = strFolder.Items.Item.Path & "\" Else Exit Sub

   arr = [A1].CurrentRegion
   If Dir(p & [C1], vbDirectory) = "" Then MkDir p & [C1]
   p = p & [C1] & "\"
   For i = 1 To UBound(arr)
      If Dir(p & arr(i, 1), vbDirectory) = "" Then MkDir p & arr(i, 1)
   Next i

End Sub

gwjkkkkk

请楼主参考附件。。。

syaoraney

limonet 发表于 2022-12-7 14:35
代码审核中

感谢帮忙做这个插件~~~~