winrar içindeki dosyayı açmak

[Erdem Akdemir]

N:\FINANS\MUHASEBE\BANKALAR\banka.rar

Yukarıdaki veriyolunundaki bir winrar dosyası içindeki bir dosyayı nasıl açarım

Dosya excel formatı değil ama excel'de açılabiliyor

İstediğim banka.rar'ın içinde ekar0102 açılsın

 

[Erdem Akdemir]

Aşağıdaki kod ile sadece dosyayı açabildim, içindeki dosyayı açmak için koda birşeyler eklemem gerek, yardımlarınızı bekliyorum

Sub ac()
Shell "Explorer.exe N:\FINANS\MUHASEBE\BANKALAR\banka.rar", vbNormalFocus
End Sub

 

[Erdem Akdemir]

arkadaşlar merhaba

bu sorunun cevabı varmı

winrar içindeki dosyayı açabiliyor muyuz?

 

[Erdem Akdemir]

dosyanın yolunu değiştirdim

"C:\Users\erdem\Documents\" içinde deneme adında bir rar dosyası var, onun içindeki excel dosyalarını açmam gerekiyor

Aşağıdaki kodu internette buldum ama kendi formatıma uyarlayamadım, ustalar bir baksanız

Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String

Fname = Application.GetOpenFilename(filefilter:="rar Files (*.rar), *.rar", _
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) <> "C:\Users\erdem\Documents\" Then
DefPath = DefPath & "\deneme"
End If

'Create the folder name
FileNameFolder = "deneme"

'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

 

[Zeki Gürsoy]

Merhaba,

Bir excel dosyasının açılabilmesi için önce arşivden "extract" yapılması gerekir.

Aşağıdaki başlık işinize yarayabilir.

Aktif dosya yedekleme ve WinRAR ile sıkıştırma (API kullanmadan)

 

[Erdem Akdemir]

Merhaba,

Bir excel dosyasının açılabilmesi için önce arşivden "extract" yapılması gerekir.

Aşağıdaki başlık işinize yarayabilir.

Aktif dosya yedekleme ve WinRAR ile sıkıştırma (API kullanmadan)

sizin dosyalarınız siteden silinmiş

 

[parametre]

burada

yukarida verdigim linkte eklenti mevcut
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.

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
Bu kodları deneyin bakalım istediğinizi karşılayacak mı? Hem zip hem rar paketi için kullanabilirsiniz.
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



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

istedigini kullan bol cesit sunduk size