[Çözüldü] - Sıkıştırılmış dosyaları excel içerisinden açma

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

[Çözüldü] - Sıkıştırılmış dosyaları excel içerisinden açma

İleti#1)  feridunabi » 03 Eyl 2009 17:41

Arkadaşlar "d:\dosyalar\deneme.zip" dosyasını winrar kullanarak, excel içinden dosyanın bulunduğu klasöre nasıl açabilirim.
Kullanıcı avatarı
feridunabi
Yeni Başlamış
 
Adı Soyadı:ümit sakınç
Kayıt: 26 Tem 2009 22:25
İleti: 70
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ankara/keçiören

Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#2)  Muhammet AYTAŞ » 03 Eyl 2009 20:27

Merhaba feridunabi(abi nerden tamışıyorduk [komik] )
Webte UnRar.ocx ile ilgili bir örnek buldum ve VB6'da düzenledim.
Şu ocx al buraya kopyala falan anlatması ve anlaması zor olabileceğinden çalışmamı doğrudan setup haline getirdim ki gerekli ocx ve dll dosyaları ilgili yerlere setup dosyası kendisi kopyaların ve register etsin.
Ek olarak VB6 proje dsoyalarını da veriyorum ki isteyen kodlara bakıp Excel'e uyarlayabilsin.
Yalnız bu çalışma rar uzantılı dosyalar için.
Buradan indiriniz.
Kullanıcı avatarı
Muhammet AYTAŞ
Yeni Başlamış
 
Adı Soyadı:Muhammet AYTAŞ
Kayıt: 05 Ekm 2008 03:12
İleti: 67
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa

Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#3)  feridunabi » 04 Eyl 2009 10:37

Excel'e uyarlanmış hali yok mu?
Kullanıcı avatarı
feridunabi
Yeni Başlamış
 
Adı Soyadı:ümit sakınç
Kayıt: 26 Tem 2009 22:25
İleti: 70
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ankara/keçiören

Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#4)  Muhammet AYTAŞ » 05 Eyl 2009 02:44

VB'de gayet güzel çalışırken referansını Excel'e eklemeye çalıştığımda bende hata verdi.

İsterseniz altta verdiğim zip paketlerini açan ve zip paketi oluşturan kodları deneyin.

Kod: Tümünü seç
Sub Zip_Paketi_Cikart()
    Dim Komut As String, Islem As Long, Parametre As String
    Dim Zip_Dosyasi As String, Hedef_Klasor As String, Win_Zip As String
   
    Win_Zip = "C:\Program Files\WinZip\WINZIP32.EXE"
    Zip_Dosyasi = ThisWorkbook.Path & Application.PathSeparator & "DosyaAdi.zip"
    Parametre = "-e"
    Hedef_Klasor = ThisWorkbook.Path & Application.PathSeparator
   
    DoEvents
    Komut = Chr(34) + Win_Zip + Chr(34) + " " + Parametre + " " + Chr(34) + Zip_Dosyasi + Chr(34) + " " + Chr(34) + Hedef_Klasor + Chr(34)
    Islem = Shell(Komut, vbNormalFocus)
    MsgBox Zip_Dosyasi & " dosyası " & vbCrLf & Hedef_Klasor & " klasörüne çıkartıldı.", vbInformation, "İşlem tamam"
End Sub

Sub Zip_Paketi_Yap()
    Dim Komut As String, Islem As Long, Parametre As String
    Dim Son_Dosya As String, Ziplenecek_Dosya As String, Win_Zip As String
   
    Win_Zip = "C:\Program Files\WinZip\WINZIP32.EXE"
    Son_Dosya = ThisWorkbook.Path & Application.PathSeparator & "Yeni.zip"
    Parametre = "-a -en -r"
    Ziplenecek_Dosya = ThisWorkbook.Path & Application.PathSeparator & "KlasorAdi\DosyaAdi.gif"
   
    DoEvents
    Komut = Chr(34) + Win_Zip + Chr(34) + " " + Parametre + " " + Chr(34) + Son_Dosya + Chr(34) + " " + Chr(34) + Ziplenecek_Dosya + Chr(34)
    Islem = Shell(Komut, vbNormalFocus)
    MsgBox Ziplenecek_Dosya & vbCrLf & Son_Dosya & vbCrLf & "olarak ziplendi.", vbInformation, "İşlem tamam"
End Sub
Kullanıcı avatarı
Muhammet AYTAŞ
Yeni Başlamış
 
Adı Soyadı:Muhammet AYTAŞ
Kayıt: 05 Ekm 2008 03:12
İleti: 67
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#5)  feridunabi » 06 Eyl 2009 23:42

Hocam ilgin için çok teşekkür ederim.
Bu kodu kullanmak için winzip programı kurulu olması lazım. Benim istediğim winrar ile yapması.
Veya, ziplenmiş kodları windowsun kendi bileşeniyle açması. Yani sistemimde winzip programını kurmak istemiyorum.
Kullanıcı avatarı
feridunabi
Yeni Başlamış
 
Adı Soyadı:ümit sakınç
Kayıt: 26 Tem 2009 22:25
İleti: 70
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ankara/keçiören

Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#6)  Muhammet AYTAŞ » 07 Eyl 2009 01:19

İyi güzel de extract etmek istideğiniz dosya zip uzantılı.
Zip dosyasını ille ki WinRar ile mi açmak istiyorsunuz?
Normalde WinRAR zip uzantıları desteklediğini biliyoruz, ama iş kodlamaya gelince bu mümkün mü, emin değilim, denemek lazım.
Kullanıcı avatarı
Muhammet AYTAŞ
Yeni Başlamış
 
Adı Soyadı:Muhammet AYTAŞ
Kayıt: 05 Ekm 2008 03:12
İleti: 67
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#7)  feridunabi » 07 Eyl 2009 10:39

Evet hocam zip dosyalarını winrar ile açmak istiyorum. Veya windowsun kendi bileşenleriyle.(Böyle olursa program kurulmasına gerek kalmaz.)
Kullanıcı avatarı
feridunabi
Yeni Başlamış
 
Adı Soyadı:ümit sakınç
Kayıt: 26 Tem 2009 22:25
İleti: 70
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ankara/keçiören

Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#8)  Muhammet AYTAŞ » 08 Eyl 2009 06:12

Bu kodları deneyin bakalım istediğinizi karşılayacak mı? Hem zip hem rar paketi için kullanabilirsiniz.

Kod: Tümünü seç
Sub Paketten_Cikart()
    Dim Win_Rar As String, KaynakDosya As String, HedefKlasor As String
    Dim KaynakYol As String, GeciciKaynak As String, GeciciDosya As String, FSO As Object
    Win_Rar = "C:\Program Files\WinRAR\WinRar.exe"
    Set FSO = CreateObject("Scripting.FilesystemObject")
    On Error GoTo hata
    KaynakYol = ThisWorkbook.Path & Application.PathSeparator
    KaynakDosya = "PSKapat Setup.rar"
    HedefKlasor = ThisWorkbook.Path & Application.PathSeparator
   
    If InStr(1, KaynakYol, " ") > 0 Then
        GeciciKaynak = "C:\" & Replace(Replace(Replace(KaynakYol, " ", "_"), "\", "_"), ":", "_")
        GeciciDosya = Replace(KaynakDosya, " ", "_")
        On Error Resume Next
        MkDir GeciciKaynak
        On Error GoTo 0
        FileCopy KaynakYol & KaynakDosya, GeciciKaynak & Application.PathSeparator & GeciciDosya
        GeciciDosya = Replace(KaynakDosya, " ", "_")
        Shell Win_Rar & " X " & CStr(GeciciKaynak & Application.PathSeparator & GeciciDosya) & " " & CStr(GeciciKaynak)
       
        Do
            On Error Resume Next
            Kill GeciciKaynak & Application.PathSeparator & GeciciDosya
        Loop Until Err.Number <> 70
       
        On Error GoTo 0
        Call Klasoru_Kopyala(GeciciKaynak, HedefKlasor)
        FSO.DeleteFolder GeciciKaynak, True
    Else
        If InStr(1, HedefKlasor, " ") > 0 Then
            GeciciKaynak = "C:\" & Replace(Replace(Replace(HedefKlasor, " ", "_"), "\", "_"), ":", "_")
            On Error Resume Next
            MkDir GeciciKaynak
            On Error GoTo 0
            Shell Win_Rar & " X " & CStr(KaynakYol & Application.PathSeparator & KaynakDosya) & " " & CStr(GeciciKaynak & Application.PathSeparator)
            Call Klasoru_Kopyala(GeciciKaynak, HedefKlasor)
            FSO.DeleteFolder GeciciKaynak, True
        Else:
            Shell Win_Rar & " X " & CStr(KaynakYol & Application.PathSeparator & KaynakDosya) & " " & CStr(HedefKlasor)
        End If
    End If
   
    Set FSO = Nothing
MsgBox "Rar paketi başarıyla çıkartıldı.", vbInformation, "İşlem tamam"
   
    Exit Sub
hata:
    MsgBox "Bir hata oluştu.", vbCritical, "İşlem başarısız"
    Set FSO = Nothing
End Sub


Sub Klasoru_Kopyala(Kaynak_Klasor As String, Hedef_Klasor As String)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FilesystemObject")
    If Right(Kaynak_Klasor, 1) = "\" Then Kaynak_Klasor = Left(Kaynak_Klasor, Len(Kaynak_Klasor) - 1)
    If Right(Hedef_Klasor, 1) = "\" Then Hedef_Klasor = Left(Hedef_Klasor, Len(Hedef_Klasor) - 1)
    FSO.CopyFolder Source:=Kaynak_Klasor, Destination:=Hedef_Klasor
    Set FSO = Nothing
End Sub
Kullanıcı avatarı
Muhammet AYTAŞ
Yeni Başlamış
 
Adı Soyadı:Muhammet AYTAŞ
Kayıt: 05 Ekm 2008 03:12
İleti: 67
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa

Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#9)  Bülent » 08 Eyl 2009 06:22

Muhammet hocam, şöyle bir şey buldum, müsadenizle;

rondebruin yazdı:Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String

Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
'Do nothing
Else
'Root folder for the new folder.
'You can also use DefPath = "C:\Users\Ron\test\"
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"

'Make the normal folder in DefPath
MkDir FileNameFolder

'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")

oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

'If you want to extract only one file you can use this:
'oApp.Namespace(FileNameFolder).CopyHere _
'oApp.Namespace(Fname).items.Item("test.txt")

MsgBox "You find the files here: " & FileNameFolder

On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub

(Ücretli program talepleriniz için iletişime geçebilirsiniz, excelvbprogram@ gmail.com)
Kullanıcı avatarı
Bülent
Yönetim Kurulu
 
Adı Soyadı:Bülent ÖZTÜRK
Kayıt: 15 Haz 2008 02:08
Meslek: Bilgi Sistemleri
Yaş: 42
İleti: 3591
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İst/Çekmeköy

Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#10)  Muhammet AYTAŞ » 08 Eyl 2009 11:06

Estafirullah, Bülent hoca.
İşyerinde olduğımdan gönderdiğin kodları denemedim, ama gördüğüm kadarıyla senin kodlar daha sade ve kullanışlı.
Bence feridunabi senin kodları kendine uyarlayıp kullasın derim.
Benim kodlar uzun ve biraz karışık.
Aslında şöyle ilk bakışta bu kod kalabalığı insanı şaşırtabilir, çünkü asıl işi yapan birkaç satır var.
Ama klasör ve ya dosya isimlerinde boşluk olunca burada işin yapan Shell komutu hata veriyor.
Dolayısıyla bu kod kalabalığı da o boşluk ihtimaline karşılık zaren.
Ama dediğim gibi arkadaş en iyisi senin kodları kendine uyarlasın.
Kullanıcı avatarı
Muhammet AYTAŞ
Yeni Başlamış
 
Adı Soyadı:Muhammet AYTAŞ
Kayıt: 05 Ekm 2008 03:12
İleti: 67
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa

Cevap: Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#11)  Bülent » 08 Eyl 2009 11:12

Muhammet AYTAŞ yazdı: Ama dediğim gibi arkadaş en iyisi senin kodları kendine uyarlasın.


Çeşit sunduk, dilediğini kullansın. ;)
Hem bu kadar çeşitliliği baharatçıda bile bulmak zor. :)
(Ücretli program talepleriniz için iletişime geçebilirsiniz, excelvbprogram@ gmail.com)
Kullanıcı avatarı
Bülent
Yönetim Kurulu
 
Adı Soyadı:Bülent ÖZTÜRK
Kayıt: 15 Haz 2008 02:08
Meslek: Bilgi Sistemleri
Yaş: 42
İleti: 3591
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İst/Çekmeköy

Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#12)  feridunabi » 08 Eyl 2009 13:59

Çok teşekkür ederim.
Winrar programına gerek kalmadan dosyaları açabildim.
Süpersiniz...
Kullanıcı avatarı
feridunabi
Yeni Başlamış
 
Adı Soyadı:ümit sakınç
Kayıt: 26 Tem 2009 22:25
İleti: 70
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ankara/keçiören

Cevap: Cevap: Cevap: Sıkıştırılmış dosyaları excel içerisind

İleti#13)  Murat OSMA » 08 Eyl 2009 16:45

Bülent yazdı:Çeşit sunduk, dilediğini kullansın. ;)
Hem bu kadar çeşitliliği baharatçıda bile bulmak zor. :)


Bülent bey, doğru söylüyor... [evet]
Kullanıcı avatarı
Murat OSMA
Site Forum Yöneticisi
 
Adı Soyadı:Murat OSMA
Kayıt: 05 Arl 2008 00:34
Konum: İstanbul
Meslek: Excel & VBA Eğitmeni
Yaş: 33
İleti: 14318
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bağcılar - İSTANBUL

Cevap: Cevap: Sıkıştırılmış dosyaları excel içerisinden açma

İleti#14)  kavakli313 » 12 Eyl 2018 13:13

Bülent yazdı:Muhammet hocam, şöyle bir şey buldum, müsadenizle;

rondebruin yazdı:Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String

Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
'Do nothing
Else
'Root folder for the new folder.
'You can also use DefPath = "C:\Users\Ron\test\"
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"

'Make the normal folder in DefPath
MkDir FileNameFolder

'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")

oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

'If you want to extract only one file you can use this:
'oApp.Namespace(FileNameFolder).CopyHere _
'oApp.Namespace(Fname).items.Item("test.txt")

MsgBox "You find the files here: " & FileNameFolder

On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub


bülent hocam acaba şifreli rar dosyasına uygulayabilirmiyiz.
Kullanıcı avatarı
kavakli313
Yeni Başlamış
 
Adı Soyadı:MUHARREM GÜL
Kayıt: 12 Nis 2012 12:16
Konum: samsun
Meslek: serbest
Yaş: 31
İleti: 39
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: SAMSUN/ATAKUM


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot, Google [Bot], Google Adsense [Bot], supervisor37 ve 2 misafir

cron
Bumerang - Yazarkafe