Vọc chơi với những thuật toán nén và giải nén file

ndu96081631 · 23/9/15

Tôi mở topic này nhằm mục đích cùng nhau nghiên cứu về nén và giải nén dùng công cụ VBA
Đầu tiên chúng ta cùng làm cuộc thí nghiệm nhỏ sau:
- Click chuột phải trên Desktop, chọn New ---> WinRAR archive (hoặc WinRAR Zip archive). Đương nhiên ta sẽ nhận được một file RAR hoặc ZIP trắng
- Tiếp theo khởi động Notepad
- Dùng chuột nắm kéo file RAR (hoặc ZIP) mới vừa tạo thả vào cửa sổ Notepad
Các bạn nhìn thấy cái gì trong Notepad?
Mời trả lời rồi chúng ta sẽ tiếp tục

Kiều Mạnh · 23/9/15

ndu96081631 đã viết:
Từ từ mà đồng chí!
Tiếp theo, từ file Zip rổng ấy, ta sẽ cho file của ta (file gì tùy ý) vào trong đó. Khi ấy file Zip sẽ có nội dung thôi

Thì cũng giống như mình kéo thả một file mới vào đó thôi .... giả nén thì được một file mới kéo vào

ndu96081631 · 23/9/15

kieu manh đã viết:
Thì cũng giống như mình kéo thả một file mới vào đó thôi .... giả nén thì được một file mới kéo vào

Vâng! Chính xác là vậy!
Phần quan trọng là code VBA sao để nén 1 file "D:\abc.xls" thành "D:\abc.zip"
Nén và giải nén có giải thuật gần giống nhau. Sau khi có bước đầu thành công, ta sẽ tính đến việc giải nén file XLSX, XLSM và làm đủ thứ việc trong đó (chẳng hạn làm Ribbon tự tạo)

VMH0307 · 23/9/15

Em xin góp vui, thay vì dùng CreateObject("Scripting.FileSystemObject"), ta có thể dùng thế này để tạo file zip cũng được:
[gpecode=vb]
Function NewZip(ByVal ZipFile As String) As Boolean
On Error GoTo ErrHandler
Open ZipFile For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
NewZip = (Err.Number = 0)
Exit Function
ErrHandler:
MsgBox Err.Description
End Function
[/gpecode]

VMH0307 · 23/9/15

ndu96081631 đã viết:
Phần quan trọng là code VBA sao để nén 1 file "D:\abc.xls" thành "D:\abc.zip"

Nếu em không lầm thì để zip 1 file thì ta có thể làm như sau:
[gpecode=vb]Sub ZipTool(ByVal Sourcefile As String)
Dim Zipfile As String
Zipfile = Sourcefile & ".zip"
FileCopy Sourcefile, Zipfile
End Sub[/gpecode]

doatmenhhon · 23/9/15

ndu96081631 đã viết:
Từ từ mà đồng chí!
Tiếp theo, từ file Zip rổng ấy, ta sẽ cho file của ta (file gì tùy ý) vào trong đó. Khi ấy file Zip sẽ có nội dung thôi

Hóng

doveandrose · 23/9/15

ndu96081631 đã viết:
Vâng! Chính xác là vậy!
Phần quan trọng là code VBA sao để nén 1 file "D:\abc.xls" thành "D:\abc.zip"
Nén và giải nén có giải thuật gần giống nhau. Sau khi có bước đầu thành công, ta sẽ tính đến việc giải nén file XLSX, XLSM và làm đủ thứ việc trong đó (chẳng hạn làm Ribbon tự tạo)

thầy ơi cho em hỏi ta nén "D:\abc.xls" thành "D:\abc.zip" để làm gì ? em chỉ hiểu theo nghĩa đen là tạo ra 1 file abc.zip . trong file này lại chứa 1 file abc.xls . xin thầy nói thêm 1 chút để tụi em hiểu rõ hơn

leonguyenz · 24/9/15

doveandrose đã viết:
thầy ơi cho em hỏi ta nén "D:\abc.xls" thành "D:\abc.zip" để làm gì ? em chỉ hiểu theo nghĩa đen là tạo ra 1 file abc.zip . trong file này lại chứa 1 file abc.xls . xin thầy nói thêm 1 chút để tụi em hiểu rõ hơn

Bài #10 có nói đó "bà chị", tiếp theo làm như bài #22 /-*+/

Kiều Mạnh · 24/9/15

Mình nghe thấy làm được cái này (chẳng hạn làm Ribbon tự tạo) là mê lắm .... vì đang kẹt cái đó nghiên cứu làm hoài nó cứ lỗi tùm lum

quocphuoc88 · 24/9/15

doveandrose đã viết:
thầy ơi cho em hỏi ta nén "D:\abc.xls" thành "D:\abc.zip" để làm gì ? em chỉ hiểu theo nghĩa đen là tạo ra 1 file abc.zip . trong file này lại chứa 1 file abc.xls . xin thầy nói thêm 1 chút để tụi em hiểu rõ hơn

Thiết nghĩ chắc Thầy Ndu đang hướng dẫn tùy chỉnh cái Ribbon tự tạo hoặc 1 vài cái khác . Mà cái tùy chỉnh Ribbon nào e cũng đang 'Chết mê chết mệt' với nó đây. Huy vọng qua topic này học được vài cái hay nữa ! @$@!^%

leonguyenz · 24/9/15

Ý thầy ndu là đọc hiểu và xào nấu mớ rau muống sau rồi đưa vào code phải không ạ:

Mã:

PK-      ! q9+p                      [Content_Types].xmlPK-      ! µU0#ơ   L               |  _rels/.relsPK-      ! ̃    ư(  Ô               h  xl/_rels/workbook.xml.relsPK-      ! @97é_  q               ª  xl/workbook.xmlPK-      ! é¦%¸‚  S               6
  xl/theme/theme1.xmlPK-      ! G$î  º               é  xl/worksheets/sheet2.xmlPK-      ! G$î  º               6  xl/worksheets/sheet3.xmlPK-      ! ₫äŸ   º                ƒ  xl/sharedStrings.xmlPK-      ! ómóh–  M  
             T  xl/styles.xmlPK-      ! B;_  @                 xl/worksheets/sheet1.xmlPK-      ! Iđ@>  [               ª  docProps/core.xmlPK-      ! —€LÖŸ  V                 docProps/app.xmlPK        ô

Kiều Mạnh · 24/9/15

quocphuoc88 đã viết:
Thiết nghĩ chắc Thầy Ndu đang hướng dẫn tùy chỉnh cái Ribbon tự tạo hoặc 1 vài cái khác . Mà cái tùy chỉnh Ribbon nào e cũng đang 'Chết mê chết mệt' với nó đây. Huy vọng qua topic này học được vài cái hay nữa !

Nếu cũng Mê thì mình Úp thêm cái này nữa liên quan tới Ribbon cho bạn nào chưa có tải về mà dùng....nói chung đồ chơi mình có gần đủ hết chỉ làm là nó tịt.... }}}}}

Kiều Mạnh · 24/9/15

leonguyenz đã viết:

Ý thầy ndu là đọc hiểu và xào nấu mớ rau muống sau rồi đưa vào code phải không ạ:

Mã:

PK-      ! q9+p                      [Content_Types].xmlPK-      ! µU0#ơ   L               |  _rels/.relsPK-      ! ̃    ư(  Ô               h  xl/_rels/workbook.xml.relsPK-      ! @97é_  q               ª  xl/workbook.xmlPK-      ! é¦%¸‚  S               6
  xl/theme/theme1.xmlPK-      ! G$î  º               é  xl/worksheets/sheet2.xmlPK-      ! G$î  º               6  xl/worksheets/sheet3.xmlPK-      ! ₫äŸ   º                ƒ  xl/sharedStrings.xmlPK-      ! ómóh–  M  
             T  xl/styles.xmlPK-      ! B;_  @                 xl/worksheets/sheet1.xmlPK-      ! Iđ@>  [               ª  docProps/core.xmlPK-      ! —€LÖŸ  V                 docProps/app.xmlPK        ô

Kiếm ở đâu ra cái mớ rau muống này vậy.... cách xào nấu làm sao để nhậu được...leonguyenz Chỉ dùm đi
Xin cảm ơn

ndu96081631 · 24/9/15

VMH0307 đã viết:
Em xin góp vui, thay vì dùng CreateObject("Scripting.FileSystemObject"), ta có thể dùng thế này để tạo file zip cũng được:
[gpecode=vb]
Function NewZip(ByVal ZipFile As String) As Boolean
On Error GoTo ErrHandler
Open ZipFile For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
NewZip = (Err.Number = 0)
Exit Function
ErrHandler:
MsgBox Err.Description
End Function
[/gpecode]

Cách này tôi có biết nhưng tôi sẽ không dùng, bởi ngoài chuyện hơi khó hiểu ra thì điều quan trọng là nó không hỗ trợ tên file tiếng Việt có dấu
-----------------

VMH0307 đã viết:
Nếu em không lầm thì để zip 1 file thì ta có thể làm như sau:
[gpecode=vb]Sub ZipTool(ByVal Sourcefile As String)
Dim Zipfile As String
Zipfile = Sourcefile & ".zip"
FileCopy Sourcefile, Zipfile
End Sub[/gpecode]

Cách này càng không được, bởi file Zip tạo ra không dùng được. Tuy nhiên cách này lại có thể dùng khi ta cần edit file xml bên trong file xlsx, xlsm (bằng cách đổi đuôi file xlsx, xlsm thành xlsx.zip, xlsm.zip rồi mở lên lấy nội dung bên trong)

ndu96081631 · 24/9/15

leonguyenz đã viết:

Ý thầy ndu là đọc hiểu và xào nấu mớ rau muống sau rồi đưa vào code phải không ạ:

Mã:

PK-      ! q9+p                      [Content_Types].xmlPK-      ! µU0#ơ   L               |  _rels/.relsPK-      ! ̃    ư(  Ô               h  xl/_rels/workbook.xml.relsPK-      ! @97é_  q               ª  xl/workbook.xmlPK-      ! é¦%¸‚  S               6
  xl/theme/theme1.xmlPK-      ! G$î  º               é  xl/worksheets/sheet2.xmlPK-      ! G$î  º               6  xl/worksheets/sheet3.xmlPK-      ! ₫äŸ   º                ƒ  xl/sharedStrings.xmlPK-      ! ómóh–  M  
             T  xl/styles.xmlPK-      ! B;_  @                 xl/worksheets/sheet1.xmlPK-      ! Iđ@>  [               ª  docProps/core.xmlPK-      ! —€LÖŸ  V                 docProps/app.xmlPK        ô

Tôi nhớ không lầm thì để làm ribbon người ta tạo ra file CustomUI.xml với cả đống lệnh trong đó. Vậy nên tôi có ý tưởng:
- Dùng VBA tạo ra cái đống lệnh rồi Save thành file CustomUI.xml
- Tiếp theo bằng phương pháp nén file (như chủ đề topic này) ta sẽ đưa CustomUI.xml vào bên trong file xlsm
Quy trình là vậy nhưng để thực thi nó thì vẫn còn nhiều bước lắm. Từ từ chúng ta cùng nghiên cứu vậy!
(Tôi ghét ribbon bởi luôn phải có công đoạn làm bằng tay. Nếu như toàn bộ đều bằng code thì.. chuyện ngon rồi)

ndu96081631 · 24/9/15

"Công trình" đầu tiên

Đây là "công trình" đầu tiên của việc nén file:

Mã:

Private Function CreateNewZip(ByVal ZipFilePath As String) As String
 'Create an empty ZIP file
  Dim FSO, sBin As String
  On Error GoTo ErrHandler
  If UCase(Right(ZipFilePath, 4)) = ".ZIP" Then
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sBin = "PK" & Chr(5) & Chr(6) & String(18, 0)
    With FSO.CreateTextFile(ZipFilePath, True)
      .Write sBin
      .Close
    End With
    If Err.Number = 0 Then CreateNewZip = ZipFilePath
    Exit Function
ErrHandler:     MsgBox Err.Description
  End If
End Function
Function FileToZip(ByVal [COLOR=#ff0000]FilePath[/COLOR]) As Boolean
  'Microsoft Shell Controls And Automation
  Dim FSO As Object
  Dim [COLOR=#ff0000]ZipFilePath, sFolder, sName[/COLOR], sFile As String
  On Error GoTo ErrHandler
  Set FSO = CreateObject("Scripting.FileSystemObject")
  sFile = CStr(FilePath)
  If FSO.FileExists(sFile) Then
    sFolder = FSO.GetFile(sFile).ParentFolder.Path
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = FSO.GetFile(sFile).Name
    If InStr(1, sName, ".") Then
      sName = Left$(sName, InStrRev(sName, "."))
      sName = sName & "zip"
      ZipFilePath = CreateNewZip(sFolder & sName)
      With CreateObject("Shell.Application")
        .Namespace([COLOR=#ff0000]ZipFilePath[/COLOR]).CopyHere .Namespace([COLOR=#ff0000]sFolder[/COLOR]).Items.Item([COLOR=#ff0000]FilePath[/COLOR])
      End With
      FileToZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
    End If
  End If
End Function
Sub TestZipFile()
  Dim bRet As Boolean
  Dim vFile
  vFile = Application.GetOpenFilename("All Files, *.*")
  If TypeName(vFile) = "String" Then
    bRet = FileToZip(vFile)
    If bRet Then MsgBox "Done!"
  End If
End Sub

Mời test thử và cùng hoàn thiện
Lưu ý quan trọng(mất công các bạn tự làm bị lỗi mà không biết): Mấy cái biến màu đỏ tuy ta có thể dùng như chuỗi nhưng tuyệt đối không được khai báo nó dạng chuỗi (kiểu như Dim FilePath as String)... nếu không code lập tức báo lỗi. Các bạn có thể thay đổi 1 vài biến màu đỏ thành dạng As String và test thử
----------------------------------
Tôi nghiên cứu tới đâu đăng bài tới đó chứ chưa có gì sẵn trong đầu cả (chỉ có ý tưởng)... vậy nên xin mời các bạn góp sức hoàn thiện (tôi tin chắc vẫn còn lỗi ở đâu đó)
Cảm ơn

doveandrose · 24/9/15

ẹc thì ra đó là lý do . biểu sao qua giờ cứ gán kiểu String vào cái thằng .nameSpace() là nó lỗi . gán trực tiếp chuỗi vào thì lại được . ......

doveandrose · 24/9/15

báo cáo thầy là dòng này không làm việc trên máy em

Mã:

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(FilePath)

mà phải vầy nó mới chịu

Mã:

.Namespace(ZipFilePath).CopyHere FilePath

ndu96081631 · 24/9/15

doveandrose đã viết:
báo cáo thầy là dòng này không làm việc trên máy em

Mã:

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(FilePath)

mà phải vầy nó mới chịu

Mã:

.Namespace(ZipFilePath).CopyHere FilePath

Mình thật may mắn khi luôn có các bạn đồng hành! Cảm ơn
-----------------------------------------------------------------
Tôi test thử trên Windows 7 (32bit) + Office 2010 (32bit) thì cả 2 cách trên đều được
Vậy mời các bạn khác test thử, nếu thay đổi như anh Chim Hồng mà không máy nào báo lỗi thì ta sẽ thống nhất dùng code này
(mục đích để máy nào cũng dùng được)

doveandrose · 24/9/15

ndu96081631 đã viết:
Mình thật may mắn khi luôn có các bạn đồng hành! Cảm ơn
-----------------------------------------------------------------
Tôi test thử trên Windows 7 (32bit) + Office 2010 (32bit) thì cả 2 cách trên đều được
Vậy mời các bạn khác test thử, nếu thay đổi như anh Chim Hồng mà không máy nào báo lỗi thì ta sẽ thống nhất dùng code này
(mục đích để máy nào cũng dùng được)

em dùng cái này

Mã:

MsgBox TypeName(.Namespace(sFolder).Items.Item(FilePath))

nó cho em cái chữ "Nothing"

ndu96081631 · 24/9/15

doveandrose đã viết:
em dùng cái này

Mã:

MsgBox TypeName(.Namespace(sFolder).Items.Item(FilePath))

nó cho em cái chữ "Nothing"

Trên máy tôi thì nó là tên cái file cần nén
Ẹc... Ẹc... ứ biết cái gì trong trái ổi... Mò là chính, mò hoài không ra thì.. hết gân!

Vọc chơi với những thuật toán nén và giải nén file

Huyền thoại GPE

I don't program, I beat code into submission!!!

Huyền thoại GPE

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

hello

Thành viên gạo cội

I don't program, I beat code into submission!!!

Thành viên thường trực

Thành viên gạo cội

I don't program, I beat code into submission!!!

File đính kèm

I don't program, I beat code into submission!!!

Huyền thoại GPE

Huyền thoại GPE

Huyền thoại GPE

File đính kèm

hello

hello

Huyền thoại GPE

hello

Huyền thoại GPE

Facebook

Group