.Rar uzantılı dosyları kod yardımıyla açmak

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,679
Excel Vers. ve Dili
Excel 2019 Türkçe
Toplu halde birden fazla ".rar" uzantılı dosyayı kod yardımıyla açmak istiyorum. ".zip" uzantılı dosyaları açmak ile örnekler buldum fakat bunu isteğime uygulayamadım. Kodlar aşağıda;
Unzip to a specific folder with WinZip (VBA)
Ron de Bruin (last update 23 Sept 2005)
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)

Note :
1) Don't forget to copy the Functions in a normal module.
2) Check out also the Zip web page if you need examples for unzip a zip file.
3) Look on this page for all command line parameters that WinZip support.

1. Unzip a zip file into a folder
2. Use GetOpenFilename to Unzip a zip file in a newly created folder in the same path
3. Functions
4. Zip file or files with the default Windows XP zip program New
5.

Unzip a zip file into a folder

The name of the zip file and destination folder are in the macro in this example.
Don't forget to copy the functions.


Kod:
Sub UnZip_ZipFile_1()
    Dim PathWinZip As String, FileNameZip As String
    Dim ShellStr As String, FolderName 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
 
    FileNameZip = "C:\Data\Test.zip"
    FolderName = "C:\Data\"
 
    'Unzip the zip file in the folder FolderName
    ShellStr = PathWinZip & "Winzip32 -min -e" _
             & " " & Chr(34) & FileNameZip & Chr(34) _
             & " " & Chr(34) & FolderName & Chr(34)
    ShellAndWait ShellStr, vbHide
    MsgBox "Look in " & FolderName & " for extracted files"
End Sub


Use GetOpenFilename to Unzip a zip file in a newly created folder in the same path

Don't forget to copy the functions

Kod:
Sub UnZip_ZipFile_2()
    Dim PathWinZip As String, FolderName As String
    Dim ShellStr As String, strDate As String, Path As String
    Dim FileNameZip As Variant, FSO As Object
 
    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")
 
    FileNameZip = Application.GetOpenFilename(filefilter:="Zip Files, *.zip")
    If FileNameZip = False Then
        'do nothing
    Else
        Path = Left(FileNameZip, Len(FileNameZip) - Len(Dir(FileNameZip)))
        FolderName = Path & Format(Now, "dd-mm-yy h-mm-ss")
 
        'Create a folder with a date/time stamp
        Set FSO = CreateObject("Scripting.FileSystemObject")
        If Not FSO.FolderExists(FolderName) Then
            FSO.CreateFolder FolderName
            'Unzip the zip file in the folder FolderName
            ShellStr = PathWinZip & "Winzip32 -min -e" _
                     & " " & Chr(34) & FileNameZip & Chr(34) _
                     & " " & Chr(34) & FolderName & Chr(34)
            ShellAndWait ShellStr, vbHide
            MsgBox "Look in " & FolderName & " for extracted files"
        Else
            MsgBox "The folder already exist"
        End If

    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.

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.

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

Kod:
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
'*****************************************************************************************
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,679
Excel Vers. ve Dili
Excel 2019 Türkçe
Teşekkürler Sayın Gürsoy, verdiğiniz kodları deneyeceğim.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,679
Excel Vers. ve Dili
Excel 2019 Türkçe
(Şirkette, Dos kullanımı yasak olduğu için) zannedersem bu yüzden;kodlarınızı çalıştıramadım. Benim verdiğim diğer kodları da, Winzip programını yüklediğim halde çalıştıramadım. Rica etsem, verdiğim kodları deneyebilir misiniz?
 

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,259
Excel Vers. ve Dili
Office 2019 (64 bit) - Türkçe
Bilgisayarımda winzip yüklü olamdığından deneme şansım yok. winrar.exe nin command yapısı (açmak dışında) yok sanırım.

Verdiğiniz kod yapısında winzip uygulamasının böyle bir özelliğinin olduğunu anlıyorum. Process i kontrol etmek için ShellWait kullanılmış.

Winrarda kararlıysanız API veya hazır ocx yapılarını kullanmanız gerekecek. API kullanım sistemini görmeniz için text dosyası ile hemen ekleyebilirim.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,679
Excel Vers. ve Dili
Excel 2019 Türkçe
Winrarda kararlıysanız API veya hazır ocx yapılarını kullanmanız gerekecek. API kullanım sistemini görmeniz için text dosyası ile hemen ekleyebilirim.
Olabilir, alternatif çözümlere herzaman açığım. Aslına bakarsanız Winrar, Winzip'e göre daha iyi sıkıştırıyor. Bu yüzden şimdiye kadar Winzip kullanmayı düşünmedim. Bununla birlikte, Winzip ile ".rar" uzantılı dosyaları açmakta mümkün hale getirilmiş. Fakat bunu, kod içine nasıl adapte edebiliriz bilmiyorum.
 
Üst