Thao tác với file zip bằng VBA

Admin tuhocvba và BTV Euler đã sử dụng ý tưởng của bạn @USA_Covid19 và hoàn thành .
Tôi thấy cần thiết phải lập một chủ đề bàn về thao tác với file zip. Khi có kiến thức nền tảng này, tôi nghĩ việc tạo Tool để unlock file macro bằng VBA giống như bạn vothanhthu đã làm là điều dễ thực hiện nếu chúng ta được cung cấp logic xử lý hợp lý giống như cách bạn USA_Covid19 nêu ý kiến.

Về cơ bản VBA không cung cấp cho chúng ta các phương thức để nén hay giải nén một file. Vì vậy trên máy tính của các bạn nên có một phần mềm nén (giải nén) ví dụ như winrar hay 7zip. Thông qua VBA chúng ta sẽ "nhờ" các phần mềm này thực hiện công việc nén hay giải nén, nhờ đó mà công việc được tự động hóa.

Hàm nén:
Mã:
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)

'Nen file
Public Function makezip(ByVal ZipPath, ByRef FileArray) As Boolean
    On Error GoTo Err_Handler
    'Khai bao bien so
    Dim FSO, sh, file, num, zipFolder
    
    'Khoi tao object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set sh = CreateObject("Shell.application")
    
    'Neu ton tai file zip trung ten thi thuc hien xoa
    If FSO.FileExists(ZipPath) = True Then
        FSO.DeleteFile ZipPath
    End If
    
    'Tao file zip rong
    With FSO.CreateTextFile(ZipPath, True)
        .Write "PK" & Chr(5) & Chr(6) & String(18, 0)
        .Close
    End With
    
    'Copy doi tuong nen toi file zip
    num = 0
    
    'Luu duong dan file zip
    Set zipFolder = sh.Namespace(FSO.GetAbsolutePathName(ZipPath))
    
    'Copy file vao file nen zip
    For Each file In FileArray
        If CStr(file) <> "" Then
        file = FSO.GetAbsolutePathName(file)
        
        'Copy vao folder zip
        zipFolder.CopyHere (file)
        
        'So luong file trong file nen
        num = num + 1
        End If
    Next
    
    'Viec copy file vao file nen ket thuc
    Do Until zipFolder.Items().Count = num
        Sleep 100
    Loop
    
    'Gia tri tra ve
    makezip = True
    
    'Ket thuc
    Set FSO = Nothing
    Set sh = Nothing
    
Exit_makezip:
    makezip = False
    Exit Function
    
Err_Handler:
    MsgBox Err.Description
    Resume Exit_makezip

End Function

'Thuc hien nen file
Public Sub testZip()
    'Khai bao bien so
    Dim ret As Boolean
    Dim filepath As Variant

    'Doi tuong nen
    Dim files(0)
    
    'Nhap duong dan thu muc chua file nen hoac file can nen
    files(0) = "C:\VBA\TreeView 026_3.xlsm"
    
    'file nen bao gom ca duoi zip
    filepath = "C:\VBA\TreeView 026_3.zip"
    
    'Thuc hien nen
    ret = makezip(filepath, files)

End Sub
(Còn nữa)
Nguồn tham khảo:
 

PTHhn

Yêu THVBA như điếu đổ
Hay nhỉ, tôi thử nén cả thư mục mà cũng được:
Mã:
files(0) = "D:\VBA\TUHOCVBA2020"
filepath = "D:\VBA\TUHOCVBA.zip"
 
Hàm giải nén:
Mã:
'Giai nen file zip
Public Function unzipman(ByVal filepath As Variant, ByVal meltpath As Variant) As Boolean
    On Error GoTo Err_Handler
    'Kiem tra folder giai nen da ton tai hay chua, neu chua thi tao ra
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If FSO.FolderExists(meltpath) Then
    Else
        MkDir meltpath
    End If
    Set FSO = Nothing
    
    'Giai nen
    With CreateObject("Shell.Application")
      .Namespace(meltpath).CopyHere .Namespace(filepath).Items
    End With
    
    'Gia tri tra ve
    unzipman = True

Err_unzipman:
    unzipman = False
    Exit Function
    
Err_Handler:
    MsgBox Err.Description
    Exit Function
End Function

'Test giai nen
Sub testmelting()
    'Khai bao bien so
    Dim filepath As Variant
    Dim meltpath As Variant
    Dim ret As Boolean
    
    'Chi dinh duong dan
    filepath = "C:\VBA\Book1.zip" 'File zip
    meltpath = "C:\Users\user\Documents\THVBA" 'Folder giai nen-folder nay chua he ton tai, chuong trinh se phai tao ra folder nay
    
    'Thuc hien giai nen zip
    ret = unzipman(filepath, meltpath)
End Sub
Nguồn:
 
D

Deleted member 1294

Guest
Các bước mở khóa vba dạng password và unviewble theo logic của mình làm trên vbnet như sau:
-Bỏ mật khẩu mở nếu có (dạng mật khẩu open đặc Biệt nếu có)
-Nén file
-Giải nén
-Tìm các chuỗi DBP.. và vị trí của nó trong file bin.
-Thay thế các chuỗi đó thành 0A.....hoặc 0D
-Nén lại-> đưa về excel !
 
D

Deleted member 1294

Guest
Bằng cách nén và giải nén các bạn thử bài toán: Không cần mở khóa file excel mà vẫn
-Lấy Được tên sheet
-Cao hơn nữa là mở khoá tất cả các sheet.
-Xác định sheet chứa mật khẩu hay không !
 

giaiphapvba

Administrator
Thành viên BQT
Các ý kiến của @USA_Covid19 còn mơ hồ, chưa đủ chi tiết để người code tiến hành làm.
Ví dụ đối với việc lấy tên sheet của file excel mà không mở trực tiếp file excel đó, ta làm như sau.
Ví dụ tôi có file là :
tuhocvba.xlsm
Bước 1: Copy file đổi tên thành tuhocvba.xlsm.zip
Bước 2: Thực hiện giải nén file zip trên ra thư mục A.
Bước 3: Mở file A\xl\workbook.xml
Bước 4: Tên các sheet của file excel được ghi trong file xml ở trên, có cấu trúc là:
Mã:
<sheet name="THVBA1" sheetId="1" r:id="rId1"/>
<sheet name="Dialog1" sheetId="5" state="veryHidden" r:id="rId2"/>
<sheet name="THVBA2" sheetId="4" r:id="rId3"/>
<sheet name="THVBA3" sheetId="6" r:id="rId4"/>
Nhiệm vụ của người lập trình là đọc nội dung trên và trả về danh sách tên sheet: THVBA1, Dialog1, THVBA2, THVBA3.
Nguồn tham khảo:
 

vqlongbn

Yêu THVBA
Set zipFolder = sh.Namespace(FSO.GetAbsolutePathName(ZipPath))
các bạn có thể giải thích giúp mình đoạn code dòng 28 này trên post #1 được không
theo mình tự tìm hiểu thì sh.namespace sẽ trả về 1 folder theo đường dẫn trong ( ), nhưng khi mình tự viết code test thì báo lỗi type mismatch tại dòng 6
Mã:
Sub testShellNameSpace()
    Dim oShell As Object
    Dim oFolder As Folder

    Set oShell = CreateObject("Shell.application")
    Set oFolder = oShell.Namespace(ThisWorkbook.Path & "\hi")

    MsgBox oFolder.Name
   
End Sub
Thanks.


//mình sửa dòng thứ 3 thành Dim oFolder thì hết lỗi type mismatch nhưng lại báo lỗi Object doesn't support this property or method ở dòng msgbox
 
Sửa lần cuối:
D

Deleted member 1392

Guest
@vqlongbn Bạn thử dùng FSO thay cho Shell thử xem
Mã:
Sub testShellNameSpace()
    Dim FSO As Object
    Dim oFolder As Folder
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = FSO.GetFolder(ThisWorkbook.Path & "\hi")

    MsgBox oFolder.Name
End Sub
 
Khi không biết rõ là gì, bạn chỉ cần viết:
Mã:
Dim oFolder
Khi khai báo như vậy thì nó trở thành biến variant.
Nếu bạn muốn lấy tên folder thì dùng thuộc tính Title
Mã:
MsgBox oFolder.Title
Nguồn tham khảo:
 

vqlongbn

Yêu THVBA
@vqlongbn Bạn thử dùng FSO thay cho Shell thử xem
Mã:
Sub testShellNameSpace()
    Dim FSO As Object
    Dim oFolder As Folder
  
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = FSO.GetFolder(ThisWorkbook.Path & "\hi")

    MsgBox oFolder.Name
End Sub
cảm ơn bác, mình dùng FSO thì OK, cái mình không hiểu là tại sao cùng trả về 1 folder mà FSO dùng được .name còn Shell thì lại không đó
Khi không biết rõ là gì, bạn chỉ cần viết:
Mã:
Dim oFolder
Khi khai báo như vậy thì nó trở thành biến variant.
Nếu bạn muốn lấy tên folder thì dùng thuộc tính Title
Mã:
MsgBox oFolder.Title
Nguồn tham khảo:
mình hiểu rồi, cảm ơn bác
 
D

Deleted member 1294

Guest
@tuhocvba trong Vbnet mình làm như sau:
-Mở file chứa password sau đó bỏ password wb.password=“”
-Lưu workbook
-Nén và giải nén
 
@tuhocvba trong Vbnet mình làm như sau:
-Mở file chứa password sau đó bỏ password wb.password=“”
-Lưu workbook
-Nén và giải nén
Hình như câu chuyện của anh là mở file excel chứa pass. Còn ý admin là có file abc.zip chứa mật khẩu là "123" (giả sử biết trước mật khẩu) thì tiến hành giải nén như nào.
Em đang nghĩ tới hàm SendKey để chuyển ký tự lên ô nhập mật khẩu.
 
D

Deleted member 1294

Guest
Muốn giải nén file chứa mật Khẩu thì phải mở rồi loại bỏ password mới giải nén được.
 

tuhocvba

Administrator
Thành viên BQT
Ý tưởng của mình là, đi kèm file Tool có một số file liên quan. Mình muốn nén file liên quan này thành sub.zip. Nhưng mà không muốn người dùng mở ra sờ mó linh tinh nên sẽ đặt mật khẩu file zip này là "123456".
Bây giờ muốn VBA có thể unzip file này mỗi khi chạy chương trình, unzip lấy ra cái mình cần xài rồi lại xóa đi sạch bong chỉ còn lại file zip gốc.
 
D

Deleted member 1294

Guest
Mình nghĩ khó đó ngay cả vbnet còn nhờ đến thư viện bên thứ 3 mới làm được.
 
D

Deleted member 1294

Guest
@tuhocvba có thể làm 1 app bằng vbnet để giải nén file Zip chứa mật khẩu và vba xử lý phần còn lại !
 

tuhocvba

Administrator
Thành viên BQT
Để tối mình thử xem sao. Tạm thời chạy code bài #1 thì ra ô nhập pass. Nên mình nghĩ ý tưởng của @Yukino Ichikawa sử dụng hàm Sendkey để gửi các ký tự mật khẩu + Enter là khả thi.
 

Euler

Administrator
Thành viên BQT
Chủ đề hay quá, em tìm được cái này, lúc nào rảnh nghiên cứu cùng mọi người vậy:
 
D

Deleted member 1294

Guest
@Euler Code này đòi hỏi máy đó phải cài 7z thì mới dùng được thì phải !
-Mình cũng làm một app bằng vbnet không cần cài đặt dùng để giải nén file zip chứa mật khẩu
-Cách dùng:
+Chương trình sẽ đọc file Thongtin.txt để ở Desktop chứa 3 thông số
+Sau đó giải nén file theo thông tin cung cấp trong file text.
 
Top