zipli dosya yolu

[vivident]

Merhaba

"" & ThisWorkbook.Path & "\referans\R0D\RestKuka\Archive.zip\KRC\R1\TrajTravail\t_000_24r.dat"

yukarıda dosya yolundan gidilerek t_000_24r.dat isimli text dosyasından verileri excele alacağım. Lakin kırmızı font ile belirttiğim dosya zipli

hata veriyor sürekli, nasıl yapılabilir, örnek dosya ektedir

Sub ac()
fname = "" & ThisWorkbook.Path & "\referans\R0D\RestKuka\Archive.zip\KRC\R1\TrajTravail\t_000_24r.dat"
'fname = "" & ThisWorkbook.Path & "\referans\R0D\RestKuka\Archive\KRC\R1\TrajTravail\t_000_24r.dat"
If fname = False Then Exit Sub
Set s1 = Sheets("referans")
With s1.QueryTables.Add(Connection:="TEXT;" & fname, Destination:=s1.Range("A1"))
        .TextFilePlatform = 28599
        .Refresh (False)
End With
Call Referansayir
End Sub

 

[antonio]

Merhaba,
.zip uzantısı başlı başına bir dosya olarak algılanmaktadır.
Dosya yolu, klasörlerden klasöre giderek, dosyaya kadar tanımlanır. Dosyaya gelince durur.
Zip dosyasının içindeki verileri kontrol etmek için, zipten çıkarmalısınız.

 

[vivident]

sayın "antonio" klasörleri zipten çıkarmaya denedim, forumda sayın kuvarinin paylaştığı örnek bir kod buldum, uyguladım, çalışıyor, lakin bir yerde takıldım. Kod çalışıyor kırmızı fontlu kısımda hata veriyor

Eğer ;
Eğer zipli dosya masaüstünde ise ve sarı fontlu kısımda aşağıdaki kodu kullanırsam, masaüstünde "deneme" isminde klasör oluşturuyor ve zipli dosya içindeki verileri bu dosya içine çıkarıyor. Sorun yaşamıyorum
Right(DefPath, 1) <> "D:\LocalData\at03531\Desktop\"

Eğer zipli dosya EEE Klasörü içinde ise ve sarı fontlu kısımda aşağıdaki kodu kullanırsam, EEE Klasörü içinde "deneme" isminde klasör oluşturuyor fakat zipli dosya içindeki verileri çıkarmıyor
Right(DefPath, 1) <> "D:\LocalData\at03531\Desktop\EEE"

Kodda nasıl bir değişiklik yapmam gerekiyor

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

Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
Else
DefPath = Application.DefaultFilePath
[COLOR="Orange"]If Right(DefPath, 1) <> "D:\LocalData\at03531\Desktop\EEE\" Then[/COLOR]
DefPath = DefPath & "\deneme"
End If

FileNameFolder = "deneme"
MkDir FileNameFolder

Set oApp = CreateObject("Shell.Application")
[COLOR="Red"]oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
[/COLOR]

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

 

[vivident]

problem çözülmüştür