Seçilen Dosyaları Sıkıştrmak

[Murat OSMA]

Seçilen dosyaları sıkıştırmak için bu kodları kullanabilirsiniz;

Kod Seç Genişlet

Sub Emre()
    Dim Uygulama As Object, Dosyalar, Ad, i&, Say&
    Ad = Application.GetOpenFilename(FileFilter:="Tüm Dosyalar (*.*),*.*", _
    FilterIndex:=1, Title:="Sıkıştırılacak Dosyaları Seçin", MultiSelect:=True)
    If Not IsArray(Ad) Then Exit Sub
    Say = UBound(Ad)
    Dosyalar = Application.DefaultFilePath & "\Evn.zip"
    Open Dosyalar For Output As #1
        Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
    Set Uygulama = CreateObject("Shell.Application")
    For i = LBound(Ad) To UBound(Ad)
        DoEvents
        Uygulama.Namespace(Dosyalar).CopyHere Ad(i)
        On Error Resume Next
        Do Until Uygulama.Namespace(Dosyalar).items.Count = i
          DoEvents
          Application.Wait (Now + TimeValue("0:00:01"))
        Loop
        Application.StatusBar = UBound(Ad) & " dosyanın " & i & "' tanesi sıkıştırıldı."
    Next i
    Application.StatusBar = False
    If MsgBox(Say & " Dosya sıkıştırıldı:" & vbNewLine & Dosyalar & _
    vbNewLine & vbNewLine & "Ziplenen dosyayı görüntülemek istiyor musunuz ?", _
    vbQuestion + vbYesNo) = vbYes Then Shell "Explorer.exe /e," & Dosyalar, 1
End Sub