Nhờ sửa code VBA

[KhiemTD3]

chào các anh chị em,
chả là em có nhặt được cái code VBA tạo folder và subfolder dùng cũng khá ổn áp, nhưng khổ cái là mỗi lần dùng lại phải vào sửa lại đường dẫn đến folder tạo (dòng được bôi vàng í ạ ) hơi bất tiện. Nay em nhờ các anh chị em giúp em gán cái đường dẫn đó vào 1 ô bất kì trong excel. để mỗi lần mở file lên thì chỉ cần dán đường dẫn vào đó rồi chạy VBA là được, không cần phải mở lên sửa code nữa được không ạ?
Em gửi code và file xin anh chị em giúp đỡ.


Sub CreateFolderStructure()
Dim objRow As Range, objCell As Range, strFolders As String

For Each objRow In ActiveSheet.UsedRange.Rows
strFolders = "C:\Users\admin\Desktop\New folder"
For Each objCell In objRow.Cells
strFolders = strFolders & "\" & objCell
Next
Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
Next
End Sub

 

[namvu230397]

With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 then
            sFolder = .SelectedItems(1)
        End If
    End With
   
    If sFolder <> "" Then
        Msgbox("Ban chua chon thu muc nao", vbOkOnly)
        Exit sub
    End If

Bạn thử thay dòng đó bằng cái này xem

 

[snow25]

chào các anh chị em,
chả là em có nhặt được cái code VBA tạo folder và subfolder dùng cũng khá ổn áp, nhưng khổ cái là mỗi lần dùng lại phải vào sửa lại đường dẫn đến folder tạo (dòng được bôi vàng í ạ ) hơi bất tiện. Nay em nhờ các anh chị em giúp em gán cái đường dẫn đó vào 1 ô bất kì trong excel. để mỗi lần mở file lên thì chỉ cần dán đường dẫn vào đó rồi chạy VBA là được, không cần phải mở lên sửa code nữa được không ạ?
Em gửi code và file xin anh chị em giúp đỡ.


Sub CreateFolderStructure()
Dim objRow As Range, objCell As Range, strFolders As String

For Each objRow In ActiveSheet.UsedRange.Rows
strFolders = "C:\Users\admin\Desktop\New folder"
For Each objCell In objRow.Cells
strFolders = strFolders & "\" & objCell
Next
Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
Next
End Sub

Sửa dòng này strFolders = "C:\Users\admin\Desktop\New folder" thành strFolders = range("A1").value trong đó ô A1 đường dẫn

 

[KhiemTD3]

With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 then
            sFolder = .SelectedItems(1)
        End If
    End With
 
    If sFolder <> "" Then
        Msgbox("Ban chua chon thu muc nao", vbOkOnly)
        Exit sub
    End If

Bạn thử thay dòng đó bằng cái này xem

cảm ơn bạn

Sửa dòng này strFolders = "C:\Users\admin\Desktop\New folder" thành strFolders = range("A1").value trong đó ô A1 đường dẫn

tốt quá ạ, nhưng mà lại xuất hiện 1 vấn đề là khi range("XX").value đặt ở đâu thì code sẽ không chạy hàng đó. ví dụ tên folder từ A1 đến A10 và range("XX").value ở ô O5. thì code sẽ chạy từ A1 đến A10 trừ A5 ra. có cách nào giải quyết giúp em được không ạ?

 

[sangh]

cảm ơn bạn

tốt quá ạ, nhưng mà lại xuất hiện 1 vấn đề là khi range("XX").value đặt ở đâu thì code sẽ không chạy hàng đó. ví dụ tên folder từ A1 đến A10 và range("XX").value ở ô O5. thì code sẽ chạy từ A1 đến A10 trừ A5 ra. có cách nào giải quyết giúp em được không ạ?

Sửa code thêm điều kiện loại trừ là được