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

vanthanhVBA

Thành viên
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

Thành viên
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"
 

Yukino Ichikawa

Thành viên
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:
 

USA_Covid19

Thành viên tích cực
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 !
 

USA_Covid19

Thành viên tích cực
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

Thành viên mới
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:

Ngày Mới

Thành viên tích cực
@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
 

Yukino Ichikawa

Thành viên
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

Thành viên mới
@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
 
Top