vanthanhVBA
VIP
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:
(Còn nữa)
Nguồn tham khảo:
Bạn cần đăng nhập để thấy link
.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
Nguồn tham khảo:
Bạn cần đăng nhập để thấy link