Xin Code quản lý thư mục bằng Excel (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
A

anhdepjai

Thành viên thường trực
Tham gia
16/6/10
Bài viết
387
Được thích
94
Gửi các bác,

Chẳng là vợ em hiện đang gặp một trục trặc là phải quản lý 1 thư mục gồm rất nhiều các thư mục con. Mỗi thư mục con có tên là số ID của công nhân viên (bên trong là ảnh, bản scan chứng minh thư ... có dạng HSA...). Có khoảng 2000 thư mục con như thế. Tất nhiên là danh sách công nhân viên được cập nhật chính xác theo bảng Excel (có số code).

Bài toán đặt ra là sau 1 thời gian, các thư mục con có tên của các công nhân đã nghỉ việc không được xóa đi, nên gây khó khăn cho người quản lý. Các bác có cách nào xóa các thư mục con dựa trên danh sách thực tế trên file excel không ah? Nếu có thì chỉ cho em với ah.

E cảm ơn
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
anhdepjai đã viết:
Gửi các bác,

Chẳng là vợ em hiện đang gặp một trục trặc là phải quản lý 1 thư mục gồm rất nhiều các thư mục con. Mỗi thư mục con có tên là số ID của công nhân viên (bên trong là ảnh, bản scan chứng minh thư ... có dạng HSA...). Có khoảng 2000 thư mục con như thế. Tất nhiên là danh sách công nhân viên được cập nhật chính xác theo bảng Excel (có số code).

Bài toán đặt ra là sau 1 thời gian, các thư mục con có tên của các công nhân đã nghỉ việc không được xóa đi, nên gây khó khăn cho người quản lý. Các bác có cách nào xóa các thư mục con dựa trên danh sách thực tế trên file excel không ah? Nếu có thì chỉ cho em với ah.

E cảm ơn
Nhấp chuột vào đây để mở rộng...

Bạn mô tả thế cũng bằng không, vì ai mà hình dung nỗi "cấu trúc thư mục" của vợ bạn là thế quái gì đâu mà giúp
 
Upvote 0
anhdepjai đã viết:
Gửi các bác,

Chẳng là vợ em hiện đang gặp một trục trặc là phải quản lý 1 thư mục gồm rất nhiều các thư mục con. Mỗi thư mục con có tên là số ID của công nhân viên (bên trong là ảnh, bản scan chứng minh thư ... có dạng HSA...). Có khoảng 2000 thư mục con như thế. Tất nhiên là danh sách công nhân viên được cập nhật chính xác theo bảng Excel (có số code).

Bài toán đặt ra là sau 1 thời gian, các thư mục con có tên của các công nhân đã nghỉ việc không được xóa đi, nên gây khó khăn cho người quản lý. Các bác có cách nào xóa các thư mục con dựa trên danh sách thực tế trên file excel không ah? Nếu có thì chỉ cho em với ah.

E cảm ơn
Nhấp chuột vào đây để mở rộng...

Yêu cầu này thuộc dạng bài tạo hoặc xoá thư mục từ danh sách trên bảng tính, bạn tìm trên diễn đàn để vận dụng. Trường hợp không tự làm được thì gửi file lên thì mọi người mới giúp được.
 
Upvote 0
Thư mục trong vấn đề này biểu hiện bằng cái gì? Có phải là folders trong Windows?
2000 folders như vậy thì Windows có mà què quặt. Chỉ có những máy chuyên về file server mới chịu nổi.

Quản lý hồ sơ mức độ lớn như vậy thì người ta dùng phần mềm chuyên nghiệp hay tối thiểu cũng phải là CSDL như Access.

Một doanh nghiệp có 2000 công nhân viên, chỉ riêng tiền lương đã xấp sỉ 5 triệu đô la/năm. Quản lý hố sơ nhân viên hà tiện vậy sao?

Vào thẳng vấn đề:
Chả ai xoá hồ sơ nhân viên cả. Xoá xong nhỡ liểm toán hay sở thuế hỏi thăm thì lấy gì khai?
Những hồ sơ của nhân viên đã thôi việc thì người ta dời vào chỗ khác. Sau 12 hoặc 24 tháng - tuỳ theo mật độ luân chuyển cnv - mà chép chúng vào nơi lưu trữ, và khi ấy mới xoá.

Vấn đề chủ chủ thớt không nằm ở vài chục dòng code VBA. Nó là cả một quy trình làm việc, cần phải xác đinh cho rõ.
 
Upvote 0
Gửi các bác,

Vấn đề em muốn đề cập ở đây là quản lý thư mục thông qua excel, chứ không nói đến vấn đề quản lý của mỗi công ty.

Em có attach kèm lên đây cái drap, mong các pro xem giúp em ah

E cảm ơn nhiều
 
Upvote 0
anhdepjai đã viết:
Gửi các bác,

Vấn đề em muốn đề cập ở đây là quản lý thư mục thông qua excel, chứ không nói đến vấn đề quản lý của mỗi công ty.

Em có attach kèm lên đây cái drap, mong các pro xem giúp em ah

E cảm ơn nhiều
Nhấp chuột vào đây để mở rộng...

Đã là quản lý thì phải có quy trình. Thông qua cái gì thì cũng phải quy trình cho rõ rệt. 2000 công nhân mà làm ăn kiểu này thì...

Cứ nghĩ là chỗ tô màu đỏ thì xoá là đã đầy đủ rồi ư?
Vấn đề đầu tiên: khi nào thì khởi sự xoá?
1. Khi vừa bôi đỏ xong thì xoá ngay: như vậy nếu bôi lầm thì sao? ráng chịu hay có cách cứu vãn?
2. Hay bôi xong rồi phải bấm nút gì đó thì mới bắt đầu xoá. Bấm nút ra sao? Cách bẫy lỗi ra sao?
Vấn đề kế tiếp: sau một thời gian, màu đỏ sẽ tùm lum trên bảng. Lúc đó sẽ làm gì?
Vấn đề kế tiếp: những thư mục không có tên trong bảng thì sao?
Sơ sơ mấy vấn đề thôi. Giải quyết xong tôi sẽ cho biết vài vấn đề nữa.
 
Upvote 0
anhdepjai đã viết:
Gửi các bác,

Vấn đề em muốn đề cập ở đây là quản lý thư mục thông qua excel, chứ không nói đến vấn đề quản lý của mỗi công ty.

Em có attach kèm lên đây cái drap, mong các pro xem giúp em ah

E cảm ơn nhiều
Nhấp chuột vào đây để mở rộng...

Muốn có bằng được thì cũng được thôi.

1. Trong cùng thư mục xyz với tập tin Excel đã có thư mục HSA Total. Tạo thêm thư mục backup. Tức trong thư mục xyz có: thư mục HSA Total, backup và tập tin Excel.

2. Alt --> F11 --> đúp chuột trên ThisWorkbook --> dán code sau
Mã: 
Private Declare Function MoveFile Lib "kernel32.dll" Alias "MoveFileA" (ByVal lpExistingFileName As String, _
        ByVal lpNewFileName As String) As Long

Private Sub Workbook_Open()
    DeleteFolders
End Sub

Sub DeleteFolders()
Dim oldname As String, newname As String, cell As Range
    For Each cell In Sheet1.Range("[COLOR=#ff0000]B5[/COLOR]:B" & [B65536].End(xlUp).Row)
        If cell.Interior.ColorIndex = [COLOR=#ff0000]3[/COLOR] Then
            oldname = ThisWorkbook.path & "\HSA Total\" & cell.Value
            newname = ThisWorkbook.path & "\backup\" & cell.Value & "_" & Date
            MoveFile oldname, newname
        End If
    Next
End Sub

3. Như vậy là những thư mục cần xóa được chuyển hết vào thư mục backup. Chúng sẽ không còn làm phiền vợ bạn nữa. Tôi thêm ngày tháng vào các thư mục di chuyển với lý do: Sau khi "xóa" thư mục vd. HSA (01) rất có thể code này do đã được giải phóng nên trong tương lai vợ bạn sẽ cấp cho người mới và bỏ "bôi đỏ". Sau đó người mới này cũng lại thôi việc (được bôi đỏ). Lúc đó trong backup sẽ có 2 thư mục vd. là HSA (01)_2013-12-30, HSA (01)_2014-10-30. Như thế là bạn có tất cả mọi công nhân với code là HSA (01) cùng với ngày xóa để nếu cần thì tiện theo dõi.
Các thư mục con của thư mục backup ở mỗi thời điểm bạn có thể ghi ra đĩa vd. DVD rồi xóa nó trên đĩa cứng. Cũng có thể nếu không cần nữa thì xóa hết trong backup mà không ghi. Nhưng thư mục backup thì chả làm phiền gì vợ bạn nên cứ để thế. Biết đâu có lúc cần?

4. Chỗ đỏ đỏ nếu trong tương lai có thay đổi thì sửa cho thích hợp.
 
Upvote 0
siwtom đã viết:
Muốn có bằng được thì cũng được thôi.

1. Trong cùng thư mục xyz với tập tin Excel đã có thư mục HSA Total. Tạo thêm thư mục backup. Tức trong thư mục xyz có: thư mục HSA Total, backup và tập tin Excel.

2. Alt --> F11 --> đúp chuột trên ThisWorkbook --> dán code sau
Mã: 
Private Declare Function MoveFile Lib "kernel32.dll" Alias "MoveFileA" (ByVal lpExistingFileName As String, _
        ByVal lpNewFileName As String) As Long

Private Sub Workbook_Open()
    DeleteFolders
End Sub

Sub DeleteFolders()
Dim oldname As String, newname As String, cell As Range
    For Each cell In Sheet1.Range("[COLOR=#ff0000]B5[/COLOR]:B" & [B65536].End(xlUp).Row)
        If cell.Interior.ColorIndex = [COLOR=#ff0000]3[/COLOR] Then
            oldname = ThisWorkbook.path & "\HSA Total\" & cell.Value
            newname = ThisWorkbook.path & "\backup\" & cell.Value & "_" & Date
            MoveFile oldname, newname
        End If
    Next
End Sub

3. Như vậy là những thư mục cần xóa được chuyển hết vào thư mục backup. Chúng sẽ không còn làm phiền vợ bạn nữa. Tôi thêm ngày tháng vào các thư mục di chuyển với lý do: Sau khi "xóa" thư mục vd. HSA (01) rất có thể code này do đã được giải phóng nên trong tương lai vợ bạn sẽ cấp cho người mới và bỏ "bôi đỏ". Sau đó người mới này cũng lại thôi việc (được bôi đỏ). Lúc đó trong backup sẽ có 2 thư mục vd. là HSA (01)_2013-12-30, HSA (01)_2014-10-30. Như thế là bạn có tất cả mọi công nhân với code là HSA (01) cùng với ngày xóa để nếu cần thì tiện theo dõi.
Các thư mục con của thư mục backup ở mỗi thời điểm bạn có thể ghi ra đĩa vd. DVD rồi xóa nó trên đĩa cứng. Cũng có thể nếu không cần nữa thì xóa hết trong backup mà không ghi. Nhưng thư mục backup thì chả làm phiền gì vợ bạn nên cứ để thế. Biết đâu có lúc cần?

4. Chỗ đỏ đỏ nếu trong tương lai có thay đổi thì sửa cho thích hợp.
Nhấp chuột vào đây để mở rộng...

Gửi bác SIWTOM,

Em làm theo chỉ dẫn nhưng kết quả không được, bác có thể sửa luôn vào file hôm trước em gửi rồi gửi qua diễn đàn cho em được không ah.

E cảm ơn nhiều
 
Upvote 0
anhdepjai đã viết:
Gửi bác SIWTOM,

Em làm theo chỉ dẫn nhưng kết quả không được, bác có thể sửa luôn vào file hôm trước em gửi rồi gửi qua diễn đàn cho em được không ah.

E cảm ơn nhiều
Nhấp chuột vào đây để mở rộng...

Bạn hãy giở từ điển của mình ra và xóa vĩnh viễn câu "không được" đi. Không được nghĩa cụ thể là thế nào? Là chạy code nhưng thư mục vẫn không được chuyển? Là chạy code thì máy đơ? Là chạy code thì nó xóa hết mọi thứ? ...
Bạn tập nói cụ thể đi.

Nên nhớ là khi mở tập tin thì thư mục HSA Total, các thư mục cần xóa và bất cứ tập tin nào trong các thư mục cần xóa không được mở.


À mà tôi sử dụng XP 32bit, còn bạn?
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Zzzz, Em đã tải file xuống nhưng tình hình là thư mục không chuyển bác ah.

Mà em sử dụng 32 bit operating System.

Thanks
 
Upvote 0
siwtom đã viết:
Thế thì tôi cũng chịu rồi. Tôi đã thử thì chuyển bình thường.
Nhấp chuột vào đây để mở rộng...

Xin chào Chú!Cháu cũng đang quan tâm đến vấn đề này, hiện cháu đang sử dụng win7-32bit và đoạn code của chú gửi cháu đã test qua nhưng không thấy hiện tượng gì xảy ra. Phiền chú có thể sửa giúp cháu làm sao nó có thể hoạt động được trên hệ điều hành này được không?
Cảm ơn Chú!
 
Upvote 0
Miền Cát Trắng đã viết:
Xin chào Chú!Cháu cũng đang quan tâm đến vấn đề này, hiện cháu đang sử dụng win7-32bit và đoạn code của chú gửi cháu đã test qua nhưng không thấy hiện tượng gì xảy ra. Phiền chú có thể sửa giúp cháu làm sao nó có thể hoạt động được trên hệ điều hành này được không?
Cảm ơn Chú!
Nhấp chuột vào đây để mở rộng...

Thú thực là tôi cho tới giờ chỉ dùng XP nên cũng chả tìm hiểu các system khác thế nào.
Xin mời đọc bài #14
 
Lần chỉnh sửa cuối:
Upvote 0
Đúng là bó tay với anh Bill.

Tôi đã thử trên máy khác với Windows 7 Starter (32bit) và đã THÀNH CÔNG. Tôi mở tập tin bình thường, không có Run As gì cả. Đề phòng trường hợp trên máy các bạn lại không thành công thì hãy "Run as admin" Excel xem sao. Hoặc cùng lắm là tắt UAC. Trên máy tôi thì mở bình thường.

Trong tập tin ở bài #9 thay đổi như ở dưới. Thay đổi duy nhất so với bài #9 là tôi thay đổi Date trong bài #9 thành Format(Date, "ddmmyyyy") - chỗ đỏ đỏ. Đúng là chuyện buồn cười và khó hiểu. Tôi không dùng Windows > XP nên không tìm hiểu.

Tôi cố tình giữ Date vì lý do đã nói trong bài #9. Còn nếu ai đó không cần thì xóa bỏ đoạn
& "_" & Format(Date, "ddmmyyyy")

Tôi đính kèm cả code dùng move ở dòng lệnh. Cả 2 phiên bản Sub DeleteFolders đều thành công khi test trên Windows 7 Starter của tôi.

Tôi đề nghị hai bạn hỏi trong chủ đề này báo kết quả test.
------------------------------------
1. Insert Module1

2. Code ThisWorkbook
Mã: 
Private Sub Workbook_Open()
    DeleteFolders
End Sub

3. CODE module1
Mã: 
Private Declare Function MoveFile Lib "kernel32.dll" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long

Sub DeleteFolders()
Dim oldname As String, newname As String, cell As Range
    For Each cell In Sheet1.Range("B5:B" & [B65536].End(xlUp).Row)
        If cell.Interior.ColorIndex = 3 Then
            oldname = ThisWorkbook.path & "\HSA Total\" & cell.Value
            newname = ThisWorkbook.path & "\backup\" & cell.Value & "_" & [COLOR=#ff0000]Format(Date, "ddmmyyyy")[/COLOR]
            MoveFile oldname, newname
        End If
    Next
End Sub

'Sub DeleteFolders()
'Dim oldname As String, newname As String, cell As Range
'    For Each cell In Sheet1.Range("B5:B" & [B65536].End(xlUp).Row)
'        If cell.Interior.ColorIndex = 3 Then
'            oldname = ThisWorkbook.path & "\HSA Total\" & cell.Value
'            newname = ThisWorkbook.path & "\backup\" & cell.Value & "_" & [COLOR=#ff0000]Format(Date, "ddmmyyyy")[/COLOR]
'            move oldname, newname
'            'Exit For
'        End If
'    Next
'End Sub

'Sub move(ByVal srcDir As String, ByVal destDir As String)
'Dim sCmd As String, sh As Object
'
'On Error GoTo ExitSub
'
'    srcDir = """" & srcDir & """"
'    destDir = """" & destDir & """"
'
'    Set sh = CreateObject("Wscript.Shell")
''        dong lenh
'        sCmd = "move /y " & srcDir & " " & destDir
''        thuc thi lenh
'        sh.Run "cmd /c " & sCmd, 0, True
'ExitSub:
'    Set sh = Nothing
'End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Gửi bác SIWTOM,

Em đã thử và thành công rồi nhé.

Thật sự cảm ơn bác nhiều
 
Upvote 0
siwtom đã viết:
Đúng là bó tay với anh Bill.

Tôi đã thử trên máy khác với Windows 7 Starter (32bit) và đã THÀNH CÔNG. Tôi mở tập tin bình thường, không có Run As gì cả. Đề phòng trường hợp trên máy các bạn lại không thành công thì hãy "Run as admin" Excel xem sao. Hoặc cùng lắm là tắt UAC. Trên máy tôi thì mở bình thường.

Trong tập tin ở bài #9 thay đổi như ở dưới. Thay đổi duy nhất so với bài #9 là tôi thay đổi Date trong bài #9 thành Format(Date, "ddmmyyyy") - chỗ đỏ đỏ. Đúng là chuyện buồn cười và khó hiểu. Tôi không dùng Windows > XP nên không tìm hiểu.

Tôi cố tình giữ Date vì lý do đã nói trong bài #9. Còn nếu ai đó không cần thì xóa bỏ đoạn
& "_" & Format(Date, "ddmmyyyy")

Tôi đính kèm cả code dùng move ở dòng lệnh. Cả 2 phiên bản Sub DeleteFolders đều thành công khi test trên Windows 7 Starter của tôi.

Tôi đề nghị hai bạn hỏi trong chủ đề này báo kết quả test.
------------------------------------
1. Insert Module1

2. Code ThisWorkbook
Mã: 
Private Sub Workbook_Open()
    DeleteFolders
End Sub

3. CODE module1
Mã: 
Private Declare Function MoveFile Lib "kernel32.dll" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long

Sub DeleteFolders()
Dim oldname As String, newname As String, cell As Range
    For Each cell In Sheet1.Range("B5:B" & [B65536].End(xlUp).Row)
        If cell.Interior.ColorIndex = 3 Then
            oldname = ThisWorkbook.path & "\HSA Total\" & cell.Value
            newname = ThisWorkbook.path & "\backup\" & cell.Value & "_" & [COLOR=#ff0000]Format(Date, "ddmmyyyy")[/COLOR]
            MoveFile oldname, newname
        End If
    Next
End Sub

'Sub DeleteFolders()
'Dim oldname As String, newname As String, cell As Range
'    For Each cell In Sheet1.Range("B5:B" & [B65536].End(xlUp).Row)
'        If cell.Interior.ColorIndex = 3 Then
'            oldname = ThisWorkbook.path & "\HSA Total\" & cell.Value
'            newname = ThisWorkbook.path & "\backup\" & cell.Value & "_" & [COLOR=#ff0000]Format(Date, "ddmmyyyy")[/COLOR]
'            move oldname, newname
'            'Exit For
'        End If
'    Next
'End Sub

'Sub move(ByVal srcDir As String, ByVal destDir As String)
'Dim sCmd As String, sh As Object
'
'On Error GoTo ExitSub
'
'    srcDir = """" & srcDir & """"
'    destDir = """" & destDir & """"
'
'    Set sh = CreateObject("Wscript.Shell")
''        dong lenh
'        sCmd = "move /y " & srcDir & " " & destDir
''        thuc thi lenh
'        sh.Run "cmd /c " & sCmd, 0, True
'ExitSub:
'    Set sh = Nothing
'End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn Chú!
Cháu cũng đã test thử, hiện chưa thấy lỗi gì.
Xin hỏi Chú thêm có thể xóa với 2 trường hợp này không ạ 1 là vào thùng rác(delete) và 2 là không vào đâu cả (shift+delete).
Mong chú chỉ giáo thêm ạ!
 
Upvote 0
Miền Cát Trắng đã viết:
Cảm ơn Chú!
Cháu cũng đã test thử, hiện chưa thấy lỗi gì.
Xin hỏi Chú thêm có thể xóa với 2 trường hợp này không ạ 1 là vào thùng rác(delete) và 2 là không vào đâu cả (shift+delete).
Mong chú chỉ giáo thêm ạ!
Nhấp chuột vào đây để mở rộng...

Thế thì tôi viết thêm một SUB "3 trong 1": hoặc chuyển thư mục sang chỗ khác, hoặc chuyển vào thùng rác, hoặc xóa vĩnh viễn.
Tôi dùng luôn hàm API vì nếu có dùng thư viện Windows Script Host Object Model thì rồi nó cũng sẽ gọi hàm system mà thôi.
-----
1. Code ThisWorkbook
Mã: 
Private Sub Workbook_Open()
    DeleteFolders
End Sub

2. CODE module1
Mã: 
Private Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAborted As Long
    hNameMaps As Long
    sProgress As String
End Type

Private Const FOF_NOCONFIRMATION As Long = &H10
Private Const FOF_NOCONFIRMMKDIR As Long = &H200
Private Const FO_MOVE As Long = &H1
Private Const FO_DELETE As Long = &H3
Private Const FOF_ALLOWUNDO As Long = &H40

Private Declare Function MoveFile Lib "kernel32.dll" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (ByRef lpFileOp As SHFILEOPSTRUCT) As Long

Sub DeleteMoveFolder(ByVal source As String, Optional ByVal dest As String = vbNullString, Optional ByVal allowUndo As Boolean = True)
'   Neu dest <> '': chuyen thu muc co ten (duong dan day du) la source sang thu muc co ten la (duong dan day du) dest
'    vd.
'    chuyen thu muc "hichic" co trong thu muc "c:\he" sang thu muc "c:\bla": DeleteMoveFolder "c:\he\hichic", "c:\bla"
'   Neu dest = "": chuyen source vao thung rac neu allowUndo = TRUE, nguoc lai thi xoa vinh vien
'   vd.
'    chuyen thu muc "hichic" co trong thu muc "c:\he" vao thung rac: DeleteMoveFolder "c:\he\hichic"
'   xoa vinh vien thu muc "hichic" co trong thu muc "c:\he": DeleteMoveFolder "c:\he\hichic", , false
'-------------
'    chuyen: DeleteMoveFolder ThisWorkbook.path & "\HSA Total\HSA (11)", ThisWorkbook.path & "\backup"
'    cho vao thung rac: DeleteMoveFolder ThisWorkbook.path & "\HSA Total\HSA (13)"
'    xoa vinh vien: DeleteMoveFolder ThisWorkbook.path & "\HSA Total\HSA (16)", , False
Dim lpFileOp As SHFILEOPSTRUCT
    lpFileOp.fFlags = FOF_NOCONFIRMATION Or FOF_NOCONFIRMMKDIR
    If dest <> "" Then
        lpFileOp.wFunc = FO_MOVE
        lpFileOp.pTo = dest & vbNullChar & vbNullChar
    Else
        lpFileOp.wFunc = FO_DELETE
        If allowUndo Then lpFileOp.fFlags = lpFileOp.fFlags Or FOF_ALLOWUNDO
    End If
    lpFileOp.pFrom = source & vbNullChar & vbNullChar
    SHFileOperation lpFileOp
End Sub

' phien ban 1 cua DeleteFolders
Sub DeleteFolders()
Dim cell As Range
    For Each cell In Sheet1.Range("B5:B" & [B65536].End(xlUp).Row)
        If cell.Interior.ColorIndex = 3 Then
            DeleteMoveFolder ThisWorkbook.path & "\HSA Total\" & cell.Value, , False
        End If
    Next
End Sub

' phien ban 2 cua DeleteFolders
'Sub DeleteFolders()
'Dim oldname As String, newname As String, cell As Range
'    For Each cell In Sheet1.Range("B5:B" & [B65536].End(xlUp).Row)
'        If cell.Interior.ColorIndex = 3 Then
'            oldname = ThisWorkbook.path & "\HSA Total\" & cell.Value
'            newname = ThisWorkbook.path & "\backup\" & cell.Value & "_" & Format(Date, "ddmmyyyy")
'            MoveFile oldname, newname
'        End If
'    Next
'End Sub

' phien ban 3 cua DeleteFolders
'Sub DeleteFolders()
'Dim oldname As String, newname As String, cell As Range
'    For Each cell In Sheet1.Range("B5:B" & [B65536].End(xlUp).Row)
'        If cell.Interior.ColorIndex = 3 Then
'            oldname = ThisWorkbook.path & "\HSA Total\" & cell.Value
'            newname = ThisWorkbook.path & "\backup\" & cell.Value & "_" & Format(Date, "ddmmyyyy")
'            move oldname, newname
'            'Exit For
'        End If
'    Next
'End Sub

'Sub move(ByVal srcDir As String, ByVal destDir As String)
'Dim sCmd As String, sh As Object
'
'On Error GoTo ExitSub
'
'    srcDir = """" & srcDir & """"
'    destDir = """" & destDir & """"
'
'    Set sh = CreateObject("Wscript.Shell")
''        dong lenh
'        sCmd = "move /y " & srcDir & " " & destDir
''        thuc thi lenh
'        sh.Run "cmd /c " & sCmd, 0, True
'        Debug.Print sCmd
'ExitSub:
'    Set sh = Nothing
'End Sub

Nếu bạn muốn xóa vĩnh viễn thì dùng phiên bản 1 của DeleteFolders
 
Upvote 0
Cháu đã test thử các trường hợp,hiện chưa thấy xảy ra lỗi.
Quả thực là rất nguy hiểm.
Cảm ơn Chú ạ!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ ! (1 người xem)
Trả lời
5
Đọc
85
PhanTuHuong
PhanTuHuong
H
Tổng hợp Công Nợ theo Công trình
Trả lời
13
Đọc
149
le_vis
L
U
VB tính tổng số cell trong 1 hàng có cùng màu với 1 cell so sánh ở cột khác
Trả lời
5
Đọc
57
Hoàng Tuấn 868
H
T
VBA LẤY THÔNG TIN TRÊN TỜ KHAI NHẬP KHẨU
Trả lời
10
Đọc
596
binhminh1408
B
H
Giúp mình ghép nhiều file thành một file. (1 người xem)
Trả lời
10
Đọc
397
hanhnguyen120221cuty
H
Nguyễn Duy Tuân
Hàm BS COMBINLIST Liệt kê các giá trị tổ hợp, chỉnh hợp, chỉnh hợp không lặp | Add-in A-Tools v10
    • Yêu thích
    • Thích
Trả lời
17
Đọc
1K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
18
Đọc
1K
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ZaloExcel v2.95: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
60
Đọc
19K
HeSanbi
HeSanbi
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng (1 người xem)
Trả lời
12
Đọc
2K
lưu tuấn dũng
L
hongphuong1997
Nên sử dụng Chatgpt hay Copilot
    • Yêu thích
Trả lời
11
Đọc
248
befaint
befaint
D
XIN HỖ TRỢ VỀ FILE EXCEL TỔNG HỢP ĐIỂM THI ĐUA
Trả lời
0
Đọc
40
DươngH193
D
L
Xin file lịch báo giảng tự động
Trả lời
2
Đọc
97
linedraw84
L
H
Xin File Theo dõi công nợ
Trả lời
0
Đọc
71
HangktGTN
H
N
Tạo file Excel dùng VBA để lấy và nối dữ liệu từ các files excel
Trả lời
39
Đọc
6K
hungnv_thct2026
H
S
Power BI. Một quá trình đòi hỏi sự kiên nhẫn.
Trả lời
4
Đọc
219
SteveNguyen1991
S
SA_DQ
  • Question Question
Bài tập VBA cho những người rỗi. . . đủ thứ! (1 người xem)
    • Ngạc nhiên
    • Cười
    • Yêu thích
Trả lời
21
Đọc
771
Phuocam
Phuocam
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
5
Đọc
125
ptm0412
ptm0412
L
Cách bật/tắt đèn led thứ 3 trên bàn phím cơ
Trả lời
1
Đọc
81
HUONGHCKT
H
C
Không thể group cột trong excel
Trả lời
10
Đọc
12K
ptm0412
ptm0412
A
  • Question Question
Em nhờ anh/chị/em/chú/bác giúp em viết code tổng hợp dữ liệu. em tính công thức nó nặng quá. em cám ơn
Trả lời
14
Đọc
1K
Hoàng Tuấn 868
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom