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

Liên hệ QC

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,954
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
 
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)
Máy em cả 2 đền được (Win7 64bit, Office 2007 32bit)
Nhân tiện anh cho em hỏi các hàm có dấu $ (Left$, Right$, Mid$,... ) khác gì so với các hàm không có dấu này (Left, Right, Mid,... ). Em thử các hàm không có dấu $ thì kết quả vẫn không có gì khác.
 
Upvote 0
Mình nghĩ từ bước 4 trở đi sẽ là:
4> Mang file CustomUI.xml đưa vào trong file xlsx.zip hoặc xlsm.zip (thủ tục nén file)
5> Đổi đuôi xlsx.zip hoặc xlsm.zip thành xlsx hoặc xlsm

thưa thầy . em không biết là các bạn bạn tham gia ở đây võ công cao đến đâu . nhưng mà cái việc chế ra file CUstomUI.xml là việc em nghĩ là không đơn giản . sao chúng ta không đi từng bước làm những cái đơn giản hơn trước . thí dụ như đọc dữ liệu từ các file sheet.xml , ghi ngược lại , vân vân để luyện kỹ năng làm việc với xml trước đã . rồi sau đó mới đủ vũ khí đi giết con đại bàng chứ .
 
Upvote 0
Máy em cả 2 đền được (Win7 64bit, Office 2007 32bit)
Nhân tiện anh cho em hỏi các hàm có dấu $ (Left$, Right$, Mid$,... ) khác gì so với các hàm không có dấu này (Left, Right, Mid,... ). Em thử các hàm không có dấu $ thì kết quả vẫn không có gì khác.

Cố tình muốn xử lý theo kiểu chuỗi đấy mà (tại vì biến ở trên ta khai báo Variant)
Tại cái tật cẩn thận (muốn làm cái gì ra cái đó)
Ẹc... Ẹc...
 
Upvote 0
thưa thầy . em không biết là các bạn bạn tham gia ở đây võ công cao đến đâu . nhưng mà cái việc chế ra file CUstomUI.xml là việc em nghĩ là không đơn giản . sao chúng ta không đi từng bước làm những cái đơn giản hơn trước . thí dụ như đọc dữ liệu từ các file sheet.xml , ghi ngược lại , vân vân để luyện kỹ năng làm việc với xml trước đã . rồi sau đó mới đủ vũ khí đi giết con đại bàng chứ .

Thì tiêu chí từ đầu của tôi là... TỪ TỪ mà (đừng nóng vội sẽ hư bột hư sugar)... từ từ và chắc corn --=0
Tôi chỉ nêu cái "viễn cảnh" gây "kích thích" thôi!
 
Upvote 0
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)

Anh thử lại cách này thử có được không?
Mã:
.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(FilePath)
Lúc đầu máy em chạy được nhưng sau khi thử cách của bạn doveandrose bây giờ thử lại không được (File tạo ra bị lỗi). Chả hiểu.
 
Upvote 0
Upvote 0
Máy em cả 2 đền được (Win7 64bit, Office 2007 32bit)
Nhân tiện anh cho em hỏi các hàm có dấu $ (Left$, Right$, Mid$,... ) khác gì so với các hàm không có dấu này (Left, Right, Mid,... ). Em thử các hàm không có dấu $ thì kết quả vẫn không có gì khác.

E nhớ không lầm là nếu thêm dấu $ sau các hàm xử lý chuỗi thì tốc độ nhanh hơn xí ah a ! ( có đọc đâu đó rồi nhưng không nhớ )
 
Upvote 0
Anh thử lại cách này thử có được không?
Mã:
.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(FilePath)
Lúc đầu máy em chạy được nhưng sau khi thử cách của bạn doveandrose bây giờ thử lại không được (File tạo ra bị lỗi). Chả hiểu.


Vừa test lại xong, đổi qua lại giữa 2 code, tất cả đều bình thường Thắng à!
Hết hồn (nhưng mọi thứ.. còn nguyên)
----------------------------------------
máy e dòng này

Thì nén ra file rỗng
nhưng nếu:

Thì mở ra có file vừa chọn nằm trong đó
Máy e Win 8+ ofice 2013 ( 32 bit )

Lúc nén ra file rổng bạn nhận được thông báo lỗi gì?
 
Upvote 0
máy tôi hàm
Mã:
.Namespace(sFolder).Items.Item([B][SIZE=3][COLOR=#ff0000]sFile[/COLOR][/SIZE][/B])
chỉ nhận kiểu Variant và là 1 file ShortName chứ hổng đươc fullName
nên code của thầy NDU chỉ có thể viết lại vậy
Mã:
Function FileToZip(ByVal FilePath) As Boolean
  'Microsoft Shell Controls And Automation
  Dim FSO As Object
  Dim ZipFilePath, sFolder, sName, [COLOR=#b22222][SIZE=3][B]sFile[/B][/SIZE][/COLOR]
  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
[COLOR=#ff0000][SIZE=3][B]    sFile = sName[/B][/SIZE][/COLOR]
    If InStr(1, sName, ".") Then
      sName = Left$(sName, InStrRev(sName, "."))
      sName = sName & "zip"
      ZipFilePath = CreateNewZip(sFolder & sName)
      With CreateObject("Shell.Application")
        .Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item([COLOR=#ff0000][SIZE=3][B]sFile[/B][/SIZE][/COLOR])
      End With
      FileToZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
    End If
  End If
End Function
 
Upvote 0
máy tôi hàm
Mã:
.Namespace(sFolder).Items.Item([B][SIZE=3][COLOR=#ff0000]sFile[/COLOR][/SIZE][/B])
chỉ nhận kiểu Variant và là 1 file ShortName chứ hổng đươc fullName
nên code của thầy NDU chỉ có thể viết lại vậy
Mã:
Function FileToZip(ByVal FilePath) As Boolean
  'Microsoft Shell Controls And Automation
  Dim FSO As Object
  Dim ZipFilePath, sFolder, sName, [COLOR=#b22222][SIZE=3][B]sFile[/B][/SIZE][/COLOR]
  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
[COLOR=#ff0000][SIZE=3][B]    sFile = sName[/B][/SIZE][/COLOR]
    If InStr(1, sName, ".") Then
      sName = Left$(sName, InStrRev(sName, "."))
      sName = sName & "zip"
      ZipFilePath = CreateNewZip(sFolder & sName)
      With CreateObject("Shell.Application")
        .Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item([COLOR=#ff0000][SIZE=3][B]sFile[/B][/SIZE][/COLOR])
      End With
      FileToZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
    End If
  End If
End Function
Mới thử thấy nén File tốt không tao thành File *.zip Rỗng ...nếu thay đổi 2 dòng sau cũng OK
PHP:
.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(sFile)
Thành như sau cũng OK
PHP:
.Namespace(ZipFilePath).CopyHere FilePath
 
Upvote 0
máy tôi hàm
Mã:
.Namespace(sFolder).Items.Item([B][SIZE=3][COLOR=#ff0000]sFile[/COLOR][/SIZE][/B])
chỉ nhận kiểu Variant và là 1 file ShortName chứ hổng đươc fullName
nên code của thầy NDU chỉ có thể viết lại vậy
Mã:
Function FileToZip(ByVal FilePath) As Boolean
  'Microsoft Shell Controls And Automation
  Dim FSO As Object
  Dim ZipFilePath, sFolder, sName, [COLOR=#b22222][SIZE=3][B]sFile[/B][/SIZE][/COLOR]
  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
[COLOR=#ff0000][SIZE=3][B]    sFile = sName[/B][/SIZE][/COLOR]
    If InStr(1, sName, ".") Then
      sName = Left$(sName, InStrRev(sName, "."))
      sName = sName & "zip"
      ZipFilePath = CreateNewZip(sFolder & sName)
      With CreateObject("Shell.Application")
        .Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item([COLOR=#ff0000][SIZE=3][B]sFile[/B][/SIZE][/COLOR])
      End With
      FileToZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
    End If
  End If
End Function
Chỗ này là mình sơ sót, ở trong Items.Item(...) phải là 1 name chứ không thể fullname
Đã vậy thì bỏ luôn sFile cho rồi (hoặc bỏ sName chứ ai lại sFile = sName)
 
Upvote 0
Mới thử thấy nén File tốt không tao thành File *.zip Rỗng ...nếu thay đổi 2 dòng sau cũng OK
PHP:
.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(sFile)
Thành như sau cũng OK
PHP:
.Namespace(ZipFilePath).CopyHere FilePath

tôi phải cố gắng làm sao cho hàm
Mã:
.Namespace(sFolder).Items.Item(sFile)
phải chạy được vì tôi biết các bài tới sẽ phải dùng đến nó chứ không dùng cái dưới này được
Mã:
.Namespace(ZipFilePath).CopyHere FilePath
 
Upvote 0
thì ai biết thầy muốn đem thằng sName gả cho ai khác nữa . "cây ổi" nhà thầy mà

OK!
Vậy chúng ta cùng test theo hàm vừa sửa nhé:
Mã:
Function FileToZip(ByVal FilePath) As Boolean
  'Microsoft Shell Controls And Automation
  Dim FSO As Object
  Dim ZipFilePath, sFolder, sName, [COLOR=#ff0000]sFile[/COLOR]
  On Error GoTo ErrHandler
  Set FSO = CreateObject("Scripting.FileSystemObject")
  sFile = CStr(FilePath)
  If FSO.FileExists([COLOR=#ff0000]CStr(sFile)[/COLOR]) Then
    sFolder = FSO.GetFile([COLOR=#ff0000]CStr(sFile)[/COLOR]).ParentFolder.Path
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = FSO.GetFile(sFile).Name
    [COLOR=#ff0000]sFile = sName[/COLOR]
    If InStr(1, sName, ".") Then
      sName = Left$(sName, InStrRev(sName, "."))
      sName = sName & "zip"
      ZipFilePath = CreateNewZip(sFolder & sName)
      With CreateObject("Shell.Application")
        .Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item([COLOR=#ff0000]sFile[/COLOR])
      End With
      FileToZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
    End If
  End If
End Function
Xem thử còn lỗi gì nữa không?
 

File đính kèm

Upvote 0
Máy e trơn tru . Tạo file nén KHÔNG RỖNG !
 
Upvote 0
Web KT

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

Back
Top Bottom