Xin hướng dẫn tạo thư mục chính và thư mục con bằng vba excel

[eherols]

Xin mọi người giúp đỡ code trường hợp sau, em có 01 userform như hình, em muốn tạo một thư mục mẹ có tên theo Textbox1 và thư mục con có tên theo textbox2 thì làm như thế nào ạ?
Em xin cám ơn ạ.

 

[johnnylinhanh]

Xin mọi người giúp đỡ code trường hợp sau, em có 01 userform như hình, em muốn tạo một thư mục mẹ có tên theo Textbox1 và thư mục con có tên theo textbox2 thì làm như thế nào ạ?

Chắc là như vầy đi? Bạn check code bên dưới thử xem

 Sub CreateFolder()
 Dim Path$
 Set fso = CreateObject("Scripting.Filesystemobject")
 Path = ThisWorkbook.Path
 If Not fso.FolderExists(Path & "\" & Me.Textbox1.value) Then
    fso.createfolder (Path & "\" & Me.Textbox1.value))
 End If
 If Not fso.FolderExists(Path & "\" & Me.Textbox1.value & "\" & Me.Textbox2.value) Then
    fso.createfolder (Path & "\" & Me.Textbox1.value & "\" & Me.Textbox2.value)
 End If
End sub

 

[HeSanbi]

Bạn có thể tham khảo hàm tạo Folder dưới đây:

Call CreateFolder("C:\ThuMucMe" & "\" & "ThuMucCon")

Sub btnCreateFolder()
    MsgBox  IIf( CreateFolder(TextBox1 & "\" & TextBox2), "Thanh cong", "Da da Loi")
End Sub

Function CreateFolder(ByVal FolderPath As String, Optional ByRef FileSystem As Object) As Boolean
  Dim FolderArray, Tmp$, i As Integer, UB As Integer, tFolder$
  tFolder = FolderPath
  If VBA.Right(tFolder, 1) = "\" Then tFolder = VBA.Left(tFolder, VBA.Len(tFolder) - 1)
  If tFolder Like "\\*\*" Then tFolder = VBA.Strings.Replace(tFolder, "\", "@", 1, 3)
  FolderArray = VBA.Split(tFolder, "\")
  If FileSystem Is Nothing Then
    Set FileSystem = VBA.CreateObject("Scripting.FileSystemObject")
  End If
  On Error GoTo Ends
  FolderArray(0) = VBA.Strings.Replace(FolderArray(0), "@", "\", 1, 3)
  UB = UBound(FolderArray)
  With FileSystem
    For i = 0 To UB
      Tmp = Tmp & FolderArray(i) & "\"
      If Not .FolderExists(Tmp) Then .CreateFolder (Tmp)
      CreateFolder = (i = UB) And Len(FolderArray(i)) > 0 And FolderArray(i) <> " "
    Next
  End With
Ends:
End Function

 

[eherols]

Chắc là như vầy đi? Bạn check code bên dưới thử xem

 Sub CreateFolder()
 Dim Path$
 Set fso = CreateObject("Scripting.Filesystemobject")
 Path = ThisWorkbook.Path
 If Not fso.FolderExists(Path & "\" & Me.Textbox1.value) Then
    fso.createfolder (Path & "\" & Me.Textbox1.value))
 End If
 If Not fso.FolderExists(Path & "\" & Me.Textbox1.value & "\" & Me.Textbox2.value) Then
    fso.createfolder (Path & "\" & Me.Textbox1.value & "\" & Me.Textbox2.value)
 End If
End sub

Dạ, em cám ơn bác nhé

Bài đã được tự động gộp: 24/6/22

Bạn có thể tham khảo hàm tạo Folder dưới đây:

Call CreateFolder("C:\ThuMucMe" & "\" & "ThuMucCon")

Sub btnCreateFolder()
    MsgBox  IIf( CreateFolder(TextBox1 & "\" & TextBox2), "Thanh cong", "Da da Loi")
End Sub

Function CreateFolder(ByVal FolderPath As String, Optional ByRef FileSystem As Object) As Boolean
  Dim FolderArray, Tmp$, i As Integer, UB As Integer, tFolder$
  tFolder = FolderPath
  If VBA.Right(tFolder, 1) = "\" Then tFolder = VBA.Left(tFolder, VBA.Len(tFolder) - 1)
  If tFolder Like "\\*\*" Then tFolder = VBA.Strings.Replace(tFolder, "\", "@", 1, 3)
  FolderArray = VBA.Split(tFolder, "\")
  If FileSystem Is Nothing Then
    Set FileSystem = VBA.CreateObject("Scripting.FileSystemObject")
  End If
  On Error GoTo Ends
  FolderArray(0) = VBA.Strings.Replace(FolderArray(0), "@", "\", 1, 3)
  UB = UBound(FolderArray)
  With FileSystem
    For i = 0 To UB
      Tmp = Tmp & FolderArray(i) & "\"
      If Not .FolderExists(Tmp) Then .CreateFolder (Tmp)
      CreateFolder = (i = UB) And Len(FolderArray(i)) > 0 And FolderArray(i) <> " "
    Next
  End With
Ends:
End Function

em cám ơn bác ạ