Cách tạo thư mục tự động dựa vào list EXCEL có sẵn

[hunglao]

chào các anh chị


Hiện tại em đang cần làm một công việc , sẽ dựa vào list có sẵn trong excel để
tạo thư mục tự động


Như trong file đính kèm


Level 1: thư mục cấp 1
level 2: thư mục con, cấp 2

_ giả sử trong quá trình tạo, nếu thư mục nào có rồi, nó sẽ bỏ qua ( kể cả level 1 và level 2)





Mỗi khi click nút lệnh excel sẽ tự đông tạo thư mục như list này vào ở đĩa D:\Thumuc\..


Em không biết post chỗ nào cho đúng nữa, mong mod thông cảm


cảm ởn a/c

 

[Hoàng Trọng Nghĩa]

Thì nghĩa cứ thử đi! Trong file ấy cứ gõ lăng nhăng gì đó đến cột J chẳng hạn. Xong sửa sub Main thảnh

Sub Main()
  Dim SrcRng As Range
  Set SrcRng = Sheet1.Range("A2:[COLOR=#ff0000][B]J[/B][/COLOR]100")
  CreateFolder SrcRng
End Sub

Test thử và kiểm tra sẽ biết liền
Ẹc... Ẹc...

OK, em test rồi, rất tuyệt vời, cell rỗng thì cũng không phát sinh lỗi.

 

[ndu96081631]

OK, em test rồi, rất tuyệt vời, cell rỗng thì cũng không phát sinh lỗi.

Qua 2 công đoạn test
CĐ1: Kiểm tra giá trị rổng

tmp1 = Trim(tmpArr(lR, lC))
If Len(tmp1) Then

CĐ2: Kiểm tra sự tồn tại của folder:

If Not .FolderExists(tmp2) then

Cuối cùng vẫn dự phòng bằng cách đặt 1 cái bẫy:

On Error GoTo ExitSub

thì sao mà lỗi được ---> Cùng lắm, số lượng thư mục vượt qua cho phép của Windows thì... thôi
Ẹc... ẹc...

 

[ShinbeLe]

Xin chào, mình cũng vừa mới có chút tìm hiểu VBA, mình thấy thư mục này nên mình có làm thử, cho mình hỏi thêm là, nếu mình muốn tự động tạo thêm 1 file txt rỗng vào mỗi folder đã tạo được không các bạn?

 

[huydoduc]

Sao em thấy em làm khác Thầy nhỉ?

Sub CreateNewFolder()
    Dim MyPath As String, MyFolderL1 As String, MyFolderL2 As String
    Dim sArray As Variant, i As Long
   
    With Sheets("Sheet1")
        sArray = Range(.[A2], .[A65536].End(xlUp)).Resize(, 2).Value
    End With
   
    MyPath = "D:\ThuMuc\"
   
    With CreateObject("Scripting.FileSystemObject")
        If .FolderExists(MyPath) = False Then .CreateFolder (MyPath)
        For i = 1 To UBound(sArray)
            MyFolderL1 = MyPath & sArray(i, 1) & "\"
            If .FolderExists(MyFolderL1) = False Then .CreateFolder (MyFolderL1)
            MyFolderL2 = MyPath & sArray(i, 1) & "\" & sArray(i, 2)
            If .FolderExists(MyFolderL2) = False Then .CreateFolder (MyFolderL2)
        Next
    End With

End Sub

Cảm ơn bạn rất nhiều nhé! Mình cũng gặp vấn đề này.

 

[luckyboy1408]

Thì copy code cho vào Module rồi Alt + F8 chạy Sub Main thôi
Nó đây
Lưu ý: Bạn tải file của tôi về máy tính, bạn lưu file chổ nào thì những thư mục được tạo ra sẽ bắt đầu từ đó

Cảm ơn thầy/anh. Lần đầu em vào web này nhưng file rất hữu ích. Em cũng như chủ thớt, chưa biết nhiều về lập trình VBA nhưng thật thú vị khi nó có thể làm được chuyện này.
Cảm ơn mọi người.