- Tham gia
- 30/5/06
- Bài viết
- 1,630
- Được thích
- 17,440
- Nghề nghiệp
- Bác sĩ
Hỏi (Workman) : 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.
Trả lời : (ThanhVo31)
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.
Zip and mail the ActiveWorkbook
This will only work if you use Outlook as your mail program
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.
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.
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.
Lưu ý ở đây là các hàm dưới đáy phải chuyển qua 1 module khác
Từ đoạn nay nhé:
Declare Function OpenProcess Lib "kernel32"...
Hơn nữa bạn phải nắm được cú pháp của command line winzip hay winrar thì nén hay giải nén hay làm sao nén cũng được
Tôi đã chạy thử sub nén activeworkbook chạy tốt!
Trả lời : (ThanhVo31)
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.
PHP:
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 SubZip and mail the ActiveWorkbook
This will only work if you use Outlook as your mail program
PHP:
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 SubChoose 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.
PHP:
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 SubChoose 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.
PHP:
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 SubFunctions
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.
Lưu ý ở đây là các hàm dưới đáy phải chuyển qua 1 module khác
Từ đoạn nay nhé:
Declare Function OpenProcess Lib "kernel32"...
Hơn nữa bạn phải nắm được cú pháp của command line winzip hay winrar thì nén hay giải nén hay làm sao nén cũng được
Tôi đã chạy thử sub nén activeworkbook chạy tốt!
)
