Cần giúp đỡ-nén file bằng VBA

  • Thread starter workman
  • Ngày gửi
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#1
Tôi muốn dùng VBA để nén một file lại nhưng không biết phải làm như thế nào. Xin các cao thủ VBA giúp 1 tay với. :wall:

Xin chân thành cám ơn trước.
 
nipvnn

nipvnn

www.mintoday.com
23/10/03
362
1
18
24
#2
Không hiểu????? bạn muốn điều gì ở một file bất kì?
 
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#3
Xin lỗi đã nêu vấn đề không rõ ràng. Như thế này nhé, tôi đã làm lệnh trong VBA để Save As một file ra xls. Tuy nhiên do file quá lớn, rất bất tiện trong việc lưu trữ và gửi email, tôi muốn nén lại (giống như winzip vậy đó). Tất nhiên có thể nén thủ công bằng Winzip hoặc Winrar, nhưng để VBA làm luôn thì tiện hơn.

Bạn có cách nào không chỉ cho mình với.
 
H

hoxulee

Sơ cấp
25/6/05
16
0
0
42
Vietnam
#4
VBA làm sao nén được, nén được chết liền
 
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#5
hoxulee nói:
VBA làm sao nén được, nén được chết liền
Được chứ, tôi dùng lệnh shell kết hợp với sendkeys, nhưng mà cách này củ chuối lắm.
 
H

hoxulee

Sơ cấp
25/6/05
16
0
0
42
Vietnam
#6
sendkey cho ai? cho thằng winrar hay winzip? nếu vậy cũng tương đương tự nén bằng tay, bác phức tạp hóa vấn đề, nén quách nó bằng tay cho rồi, nếu bác có cách gì độc chiêu thì post lên cho anh em học hỏi với.
 
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#7
Đâu có phức tạp hóa gì đâu, muốn làm mấy tool tự động cho khỏe người ấy mà. Chả là hàng tháng tôi phải process xuất ra file excel và gửi email cho các bộ phận liên quan. Nhưng mà file lớn quá phải nén lại mới gửi email được. Mình làm được phần xuất ra file rồi, cũng viết xong phần gửi bằng outlook, chỉ có tội là file lớn quá nên chương trình không gửi email được.

Cùng đường mới phải dùng shell+sendkeys (vào winzip) đấy chứ. Vẫn biết là củ chuối nhưng không còn cách nào khác. Mình bí quá mới lên đây hỏi các cao thủ nhờ giúp đỡ.
 
nipvnn

nipvnn

www.mintoday.com
23/10/03
362
1
18
24
#8
workman thân mến.
Ý tưởng của bạn thì người ta thường gọi là ý tưởng " điên rồ" nói vậy mong bạn bỏ qua cho mình nhé, vì khi xưa mình cũng rất hay như vậy, luôn luôn bị người khác nói là." Hâm". nhưng thực tế thì mình đam mê cái mình đã nghĩ ra đúng không?

Với VBA, bạn xác định nén file theo kiểu này có một số hạn chế như sau.
Không tạo được tính tổng thể và liên tục. Thứ nữa làm như vậy rất tốn công và mất sức, có thời gian đó nghĩ cái gì điên điên hơn tí hihi.

Mình không biết bạn viết đến đâu với cái dòng lênh VBA rồi, hiện tại xét trên nguyên tắc bạn vẫn phải zip lại những gì bạn đã làm được, mà tiền thân của nó lại la winrar or zip, trong VBA có một số hàm có khả năng package khá tốt, tuy nhiên bạn nên khởi tạo các biến riêng, và phải dùng thuật toán tương đối phức tạp.

Thực tình bạn viết như vậy cũng không khác gì là viết một chương trình nén file cả, sự ưu điểm và nhược điểm chắc bạn rõ chứ??
Tôi lấy đơn cử như mấy anh chàng zip hiện tại, ra ver mới nhất còn die ngay, vì thế tôi khuyên bạn bỏ ý tưởng này đi, có cái gì hay hơn thì nói ra, khó khăn chúng ta cùng giải quyết. Tôi có vài ý tưởng của .Net, nếu bạn có hào hứng thì chúng ta cùng làm, hoặc chơi J++ cũng okie :) chúc bạn có những ngày tươi đẹp với ý tưởng mới.
 
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#9
Thank you các bác đã giúp đỡ. Cuối cùng tôi đã tìm ra giải pháp rồi. Dùng WWZIP.exe của Winzip là xong tất. Chỉ cần tạo 1 file .bat trong cùng thư mục là chạy mát trời luôn.
 
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#10
nipvnn nói:
Thực tình bạn viết như vậy cũng không khác gì là viết một chương trình nén file cả, sự ưu điểm và nhược điểm chắc bạn rõ chứ??
Tôi lấy đơn cử như mấy anh chàng zip hiện tại, ra ver mới nhất còn die ngay, vì thế tôi khuyên bạn bỏ ý tưởng này đi, có cái gì hay hơn thì nói ra, khó khăn chúng ta cùng giải quyết. Tôi có vài ý tưởng của .Net, nếu bạn có hào hứng thì chúng ta cùng làm, hoặc chơi J++ cũng okie :) chúc bạn có những ngày tươi đẹp với ý tưởng mới.
Mình là dân kế toán 100% mà, nên thú thực mù tịt về .net. Với lại mình cũng già quá rồi, không được như các bạn trẻ bây giờ. Bạn có tài liệu tham khảo về .net không , chia sẻ cho mình với.
 
H

hoxulee

Sơ cấp
25/6/05
16
0
0
42
Vietnam
#11
workman nói:
Thank you các bác đã giúp đỡ. Cuối cùng tôi đã tìm ra giải pháp rồi. Dùng WWZIP.exe của Winzip là xong tất. Chỉ cần tạo 1 file .bat trong cùng thư mục là chạy mát trời luôn.
Thế bác nén bằng shell và sendkeys à? Hay nén bằng tay? Bác thử dùng winrar đi, nó nén tốt hơn winzip, dung lượng file sẽ nhỏ hơn.
Theo tôi nghĩ, nếu bác là dân kế toán thì không cần học .NET làm gì, học nhiều cho vỡ đầu, bác chỉ cần biết cơ sở dữ liệu, VB, VBA được rồi và sơ sơ về web chẳng hạn html
 
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#12
Đâu có, thằng WZZIP.EXE là một add-on của Winzip 9.0, chuyên trị dùng để nén bằng DOS. mình dùng shell gọi tập tin .bat lên thôi.

Bữa nọ dùng sendkeys xi cà que lắm, chạy lúc được lúc không.
 
N

nguoiconxunui

Khách vãng lai
29/6/04
1,263
211
63
Bình Định
aso2pc.co.cc
#13
winzip khi nén thì phải có soft để unzip>>nó củ chuối thật nếu không dùng add on WZZIP.EXE .
Còn các cái khác như 7zip,rar...thì hổ trợ nen tự chạy dạng như .exe không cần chương trình unzip.
Còn muốn cắt file nhỏ ra thì có các chương trình split khá hay, nó tạo file .bat, run phát là ok liền.
Ai cao thủ thì dùng mấy cái script cũng làm được nhưng cực khổ mà không hiệu quả chút nào. Ai lại có sẵn ko sài. Để thời gian làm cái khác chứ.
 
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#15
Tuanktcdcn nói:
Thoi xa xua toi dung PKZip.exe va PKUnzip nhung no chi nen ra mot file dai toi da 8 ky tu (theo tieu chuan MS-DOS). Neu moi nguoi muon toi se post len cach dung.
Hồi xưa tôi cũng có dùng hắn, nhưng bây giờ để đâu mất rồi. Bác còn post lên cho bà con tham khảo nhé.

Cơ quan tớ không cho dùng thằng PK vì không có licence, chắc chỉ dám thử ở nhà thôi
 
H

hoang1976

Sơ cấp
29/3/05
34
0
0
42
Hanoi
#16
Hello workman!

Mình rất ủng hộ quan điểm của bạn, nếu hàng ngày cứ phải làm một công việc ( dù đơn giản) thì tốt nhất là không phải làm vẫn hơn, ý mình muốn nói là thà mất công một lần (viết code) để những ngày sau rảnh tay làm việc khác vẫn hơn hi hi. Tuy rằng các thành viên khác nói là dùng tay cho nó xong nhưng nếu một ngày mà các bác cứ phải dùng tay khoảng 10 đến 20 lần thì... vừa mất thời gian mà đôi khi còn phân tâm không chính xác ấy chứ hehehe, nhất là những người già như ....workman và tôi.... :banana:

Mình cũng không phải là dân IT, mình cũng hay phải gửi giữ liệu qua mail. Nếu bạn đã có cách khắc phục được tình trạng dung lượng quá lớn khi xuất file thì bạn gửi cho mình đoạn code và hướng dẫn sử dụng đó với nhé ( nếu không dùng zip90 thì có sài được không??)

Chờ mail của workman: nganngongannga@yahoo.com
 
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#17
hoang1976 nói:
Hello workman!

Mình cũng không phải là dân IT, mình cũng hay phải gửi giữ liệu qua mail. Nếu bạn đã có cách khắc phục được tình trạng dung lượng quá lớn khi xuất file thì bạn gửi cho mình đoạn code và hướng dẫn sử dụng đó với nhé ( nếu không dùng zip90 thì có sài được không??)

Chờ mail của workman: nganngongannga@yahoo.com
Đoạn code như thế này:
Dim Appl
Appl = Shell("Nenfile.bat", vbMaximizedFocus)

Trong đó tập tin nenfile.bat như sau

wzzip e:\working\Nenfile.zip e:\working\*.xls
 
T

thanhvo31

Sơ cấp
17/7/05
36
0
0
44
Haiphong
#18
Try this link http://www.rondebruin.nl/zip.htm
or here you are:
Zip Activeworkbook, File or Files with WinZip (VBA)
Ron de Bruin (last update 20 Juny 2004)
Go to the Excel tips page

Many thanks to Dave Peterson for his help to create this page.
The examples are only working If you use WinZip as your Zip program.
(Note: you must have a registered copy of WinZip)

Don't forget to copy the Functions in a normal module.
Check out also the Unzip web page if you need examples for unzip a zip file
Note : If you want to add a Password use this –sPassword then in the ShellStr.

Zip the ActiveWorkbook
Zip and Mail the ActiveWorkbook (with Outlook)
Choose one file with GetOpenFilename and zip it
Choose more files with GetOpenFilename and zip them
Functions


Zip the ActiveWorkbook


This example will zip the active workbook.
The zip file will be saved in the same folder.


Sub Zip_ActiveWorkbook()
Dim PathWinZip As String, FileNameZip As String, FileNameXls As String
Dim ShellStr As String, strDate As String

PathWinZip = "C:\program files\winzip\"
'This will check if this is the path where WinZip is installed.
If Dir(PathWinZip & "winzip32.exe") = "" Then
MsgBox "Please find your copy of winzip32.exe and try again"
Exit Sub
End If

' Build the date/Time string
strDate = Format(Now, "dd-mm-yy h-mm-ss")

' Build the path and name for the zip file
FileNameZip = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & " " & strDate & ".zip"

' Build the path and name for the xls file
FileNameXls = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & " " & strDate & ".xls"

' Use SaveCopyAs to save the file with a Date/Time stamp
ActiveWorkbook.SaveCopyAs FileName:=FileNameXls

'Zip the file
ShellStr = PathWinZip & "Winzip32 -min -a" _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)
ShellAndWait ShellStr, vbHide

'Delete the file that you saved with SaveCopyAs
Kill FileNameXls

MsgBox "The macro is ready"
End Sub






Zip and mail the ActiveWorkbook

This will only work if you use Outlook as your mail program

Sub ActiveWorkbook_Zip_Mail()
'This sub will send a newly created workbook (copy of the Activeworkbook).
'It zip and save the workbook before mailing it with a date/time stamp.
'After the zip file is sent the zip file and the workbook will be deleted from your hard disk.
Dim PathWinZip As String, FileNameZip As String, FileNameXls As String
Dim ShellStr As String, strDate As String
Dim OutApp As Object
Dim OutMail As Object

PathWinZip = "C:\program files\winzip\"
'This will check if this is the path where WinZip is installed.
If Dir(PathWinZip & "winzip32.exe") = "" Then
MsgBox "Please find your copy of winzip32.exe and try again"
Exit Sub
End If

' Build the date/Time string
strDate = Format(Now, "dd-mm-yy h-mm-ss")

' Build the path and name for the zip file
FileNameZip = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & " " & strDate & ".zip"

' Build the path and name for the xls file
FileNameXls = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & " " & strDate & ".xls"

' Use SaveCopyAs to save the file with a Date/Time stamp
ActiveWorkbook.SaveCopyAs FileName:=FileNameXls

'Zip the file
ShellStr = PathWinZip & "Winzip32 -min -a" _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)
ShellAndWait ShellStr, vbHide

'Send the File
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "ZipMailTest"
.Body = "Here is the File"
.Attachments.Add FileNameZip
.send
End With
Set OutMail = Nothing
Set OutApp = Nothing

'Delete the file that you saved with SaveCopyAs and the Zip file
Kill FileNameZip
Kill FileNameXls
End Sub




Choose one file with GetOpenFilename and zip it



This example use GetOpenFilename to select a file and zip it.
The zip file will be saved in the same folder.

Sub Zip_Selected_File()
Dim PathWinZip As String, FileNameZip As String, FileName As String
Dim ShellStr As String, strDate As String, sFileNameXls As String
Dim vArr As Variant, FileNameXls As Variant

PathWinZip = "C:\program files\winzip\"
If Dir(PathWinZip & "winzip32.exe") = "" Then
MsgBox "Please find your copy of winzip32.exe and try again"
Exit Sub
End If
strDate = Format(Now, " dd-mm-yy h-mm-ss")

FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls")

If FileNameXls = False Then
'do nothing
Else
vArr = Split97(FileNameXls, "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close : " & FileNameXls
Exit Sub
End If

FileNameZip = Left(FileNameXls, Len(FileNameXls) - 4) & strDate & ".zip"
ShellStr = PathWinZip & "Winzip32 -min -a" _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)

ShellAndWait ShellStr, vbHide
MsgBox "The macro is ready"
End If
End Sub






Choose more files with GetOpenFilename and zip them



This example use GetOpenFilename to select a file or files and zip it.
The zip file will be saved in C:\.
Hold the CTRL key when You select the files you want.

Sub Zip_Selected_Files()
Dim PathWinZip As String, FileNameZip As String, NameList As String
Dim ShellStr As String, strDate As String, sFileNameXls As String
Dim vArr As Variant, FileNameXls As Variant, iCtr As Long

PathWinZip = "C:\program files\winzip\"
If Dir(PathWinZip & "winzip32.exe") = "" Then
MsgBox "Please find your copy of winzip32.exe and try again"
Exit Sub
End If

FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameZip = "C:\MyFilesZip " & strDate & ".zip "
ShellStr = PathWinZip & "Winzip32 -min -a " _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & NameList
ShellAndWait ShellStr, vbHide
MsgBox "The macro is ready"
End If
End Sub




Functions



The examples use shell to run the winzip32.exe file.
You need the ShellAndWait function to wait until it the zip code is finished and run your other code.
The last two examples on this page use also the functions bIsBookOpen and Split97.


Where do I copy the code/functions?


1. Alt-F11
2. Insert>Module from the Menu bar
3. Paste the Code below
4. Alt-Q to go back to Excel

Copy this code below in the module

You can use a separate module for the macro examples.


'*************************************************************************************************

Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103



Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long
'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub


Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function


Function Split97(sStr As Variant, sdelim As String) As Variant
'Tom Ogilvy
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function
'*****************************************************************************************
 
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#19
Có thế chứ. Đa tạ đa tạ. Tôi chưa thử được, nhưng đọc code thấy tuyệt vời quá, đúng ngay phần của mình đang kẹt cứng. Cám ơn ThanhVo31 nhiều nhé.
 
W

workman

Cao cấp
22/7/05
372
0
0
46
Ho Chi Minh
#20
thanhvo31 nói:
'Zip the file
ShellStr = PathWinZip & "Winzip32 -min -a" _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)
ShellAndWait ShellStr, vbHide

****
sao lệnh ShellAndWait không chạy vậy bạn?
 

Thành viên trực tuyến

  • thoibimat
  • linhhailongvan123
  • daongocnam0603
  • Trangtb59
  • thapsangniemtin
  • KIMTUYEN140517
  • duthaihung



Xem nhiều