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

Thảo luận trong 'Ứng dụng Excel' bắt đầu bởi workman, 1 Tháng tám 2005.

7,591 lượt xem

  1. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    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.
     
    #1
  2. nipvnn

    nipvnn www.mintoday.com

    Bài viết:
    362
    Đã được thích:
    1
    Không hiểu????? bạn muốn điều gì ở một file bất kì?
     
    #2
  3. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    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.
     
    #3
  4. hoxulee

    hoxulee Thành viên sơ cấp

    Bài viết:
    16
    Đã được thích:
    0
    Nơi ở:
    Vietnam
    VBA làm sao nén được, nén được chết liền
     
    #4
  5. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    Đượ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.
     
    #5
  6. hoxulee

    hoxulee Thành viên sơ cấp

    Bài viết:
    16
    Đã được thích:
    0
    Nơi ở:
    Vietnam
    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.
     
    #6
  7. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    Đâ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 đỡ.
     
    #7
  8. nipvnn

    nipvnn www.mintoday.com

    Bài viết:
    362
    Đã được thích:
    1
    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.
     
    #8
  9. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    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.
     
    #9
  10. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    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.
     
    #10
  11. hoxulee

    hoxulee Thành viên sơ cấp

    Bài viết:
    16
    Đã được thích:
    0
    Nơi ở:
    Vietnam
    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
     
    #11
  12. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    Đâ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.
     
    #12
  13. nguoiconxunui

    nguoiconxunui Khách vãng lai

    Bài viết:
    1,255
    Đã được thích:
    219
    Nơi ở:
    Bình Định
    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ứ.
     
    #13
  14. Tuanktcdcn

    Tuanktcdcn Lão già ham vui

    Bài viết:
    548
    Đã được thích:
    50
    Nơi ở:
    Hà 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.
     
    #14
  15. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    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
     
    #15
  16. hoang1976

    hoang1976 Thành viên sơ cấp

    Bài viết:
    34
    Đã được thích:
    0
    Nơi ở:
    Hanoi
    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
     
    #16
  17. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    Đ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
     
    #17
  18. thanhvo31

    thanhvo31 Thành viên sơ cấp

    Bài viết:
    36
    Đã được thích:
    0
    Nơi ở:
    Haiphong
    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
    '*****************************************************************************************
     
    #18
  19. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    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é.
     
    #19
  20. workman

    workman Thành viên hoạt động

    Bài viết:
    372
    Đã được thích:
    0
    Nơi ở:
    Ho Chi Minh
    sao lệnh ShellAndWait không chạy vậy bạn?
     
    #20

Chia sẻ trang này