Klasörün içindeki dosyaların sayfalarını listeleme

[halit3]

Ekli dosya klasörün içindeki excel dosyalarının sayfa isimlerini listeliyor.

İki adet userform mevcut.

Birisi listbax nesnesine dosyaların sayfa isimlerini listeliyor ve bu dosyaları çift tıklayınca açıyor.
Diğeri sayfaya dosyadaki sayfa isimlerini köprü kurarak listeliyor ve tıklayınca dosyayı açıyor.

Not: dosya şifreli veya korumalı olmamalı!
Korunan veya şifrelenen dosyalarda uygulama yapmamaktadır.

 

[1Al2Ver]

Sayın halit3, merhaba,

Paylaşımınız için teşekkürler...

 

[halit3]

Sayın halit3, merhaba,

Paylaşımınız için teşekkürler...

teşekkürler iyi çalışmalar

 

[simetri.]

Paylaşım için teşekkürler Halit Bey.

 

[halit3]

Paylaşım için teşekkürler Halit Bey.

teşekkürler iyi çalışmalar

 

[dragotreis]

hiçbir şey olmuyor

 

[Ahmet ÖZGÜR]

Merhaba Üstad,

Öncelikle elinize sağlık çok güzel bir çalışma.

Userform1 deki işlemi klasör seçmeden Vba dan yol göstersek UserForm1 e tıklayınca o yoldakileri listelese olabilir mi?

İyi Çalışamalar

Ekli dosya klasörün içindeki excel dosyalarının sayfa isimlerini listeliyor.

İki adet userform mevcut.

Birisi listbax nesnesine dosyaların sayfa isimlerini listeliyor ve bu dosyaları çift tıklayınca açıyor.
Diğeri sayfaya dosyadaki sayfa isimlerini köprü kurarak listeliyor ve tıklayınca dosyayı açıyor.

Not: dosya şifreli veya korumalı olmamalı!
Korunan veya şifrelenen dosyalarda uygulama yapmamaktadır.

 

[halit3]

Dosyaya 1adet userform3 ekledim. kod:

Private Sub CommandButton1_Click()

ListBox1.Clear
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "100;100;0;0" 'lisbox'taki sütunların genişliği
Kaynak = ThisWorkbook.Path
Liste (Kaynak)

MsgBox "işlem tamam"

End Sub

Private Sub Liste(yol As String)
Dim fL As Object, f As Object, Dosya As Object

Set fL = CreateObject("Scripting.FileSystemObject")

For Each Dosya In fL.GetFolder(yol).Files

Uzanti = fL.GetExtensionName(Dosya)
Application.DisplayAlerts = False
If ThisWorkbook.Name <> Dosya.Name And fL.GetFile(Dosya).Type = "Microsoft Excel Çalışma Sayfası" Then

Dim Katalog As Object, Data As Object, Tablo As Object
Dim son1
Set Data = CreateObject("ADODB.Connection")
Set Katalog = CreateObject("ADOX.Catalog")
Dosya_Yolu = (Dosya)
If Uzanti = "xls" Or Uzanti = "xlsb" Or Uzanti = "xlsx" Or Uzanti = "xlsm" Then

On Error Resume Next

If Uzanti = "xls" Then
Data.Open "Driver={Microsoft Excel Driver (*.xls)};Dbq=" & Dosya_Yolu & ";"
Else
Data.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};Dbq=" & Dosya_Yolu & ";"
End If


Katalog.ActiveConnection = Data
For Each Tablo In Katalog.Tables
If InStr(1, Tablo.Type, "TABLE") > 0 Then
If Right(Tablo.Name, 19) <> "kaynağından_sorgula" Then
If Right(Tablo.Name, 14) <> "Yazdırma_Alanı" Then
son1 = Replace(Tablo.Name, "'", "")
If Right(son1, 1) <> "_" Then
If Right(son1, 1) = "$" Then

sat1 = ListBox1.ListCount
ListBox1.AddItem
ListBox1.List(sat1, 0) = Left$(son1, Len(son1) - 1)
ListBox1.List(sat1, 1) = Dosya.Name
ListBox1.List(sat1, 2) = Dosya

End If
End If
End If
End If
End If
Next
Set Data = Nothing
Set Katalog = Nothing

End If
End If

Next

On Error GoTo sonraki
For Each f In fL.GetFolder(yol).SubFolders
Kaynak = f.Path

Liste (Kaynak)
sonraki:
Next

Set fL = Nothing
End Sub

 

[Ahmet ÖZGÜR]

Bilgisayar başına geçince hemen bakacağım.

İyi çalışmalar


Tapatalk kullanarak iPhone aracılığıyla gönderildi

 

[assenucler]

Sayın Halit3,

Üstadım iyi günler.

Yukarıdaki dosyalarınızı indirdim. User form 1, user form 2 ve user form 3 ile Klasör içinde uzantısı xls uzantılı dosyaları sayfaları listeliyor ve açabiliyorum. Emek ve paylaşımınız için teşekkürler.

Ancak, dosyalarınızı xlsx'e çevirdiğimde, klasördeki excel dosyalarını ne listelebiliyor ve ne de açabiliyorum.
Office 365 Ev ekstra kullanıyorum.

Ne yapmam gerektiğine ilişkin düşünce ve görüşünüzü almak istiyorum.

Sevgi ve saygılar.

 

[halit3]

If ThisWorkbook.Name <> Dosya.Name And fL.GetFile(Dosya).Type = "Microsoft Excel Çalışma Sayfası" Then

yukarıdaki bölümü aşağıdaki ile değiştir.

If ThisWorkbook.Name <> Dosya.Name Then

 

[assenucler]

Üstadım gerekli düzeltmeyi yaptım, olumlu bir sonuç alamadım.

Dosyam ilişiktedir.

 

[assenucler]

Dosya boyutu büyük olduğu ve daha önce yüklediğim dosyanın silindiğini fark etmem üzerine, yukarıdaki dosyayı ekledim.

 

[halit3]

12 nolu mesajdaki dosyanızı indirdim kodlar bende çalışıyor.

 

[assenucler]

Üstadım,

12. iletiye eklediğim dosyadaki kodlar bende tam değil kısmi olarak çalışmaktadır. Ekli word dosyasına eklediğim resimlerde de görüleceği gibi, uzantısı xlsx yapılan dosyanızda "userform 1" , klasördeki sayfaları listelemezken;
"userform 3" tüm dosyaları ayırt etmeksizin listelemektedir.

 

[halit3]

Userform1 silin userform3 kullanın kodlar bir birinin benzerleri

 

[assenucler]

Sorun, Office 15 sürümünü kullanmamdan kaynaklanabilir mi?

 

[assenucler]

Diğer Userform'ları kaldırdım. Öneriniz için teşekkürler.

Userform 3 ile gelen dosyalara, çift tıklama ile ulaşmak çok güzel. Verdiğiniz emek ve paylaşımınız için ne kadar teşekkür etsek azdır.
Sağ olun, var olun Sayın Halit3 üstadım.

Sevgi ve saygılar.

 

[Ahmet ÖZGÜR]

Dosyaya 1adet userform3 ekledim. kod:

Private Sub CommandButton1_Click()

ListBox1.Clear
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "100;100;0;0" 'lisbox'taki sütunların genişliği
Kaynak = ThisWorkbook.Path
Liste (Kaynak)

MsgBox "işlem tamam"

End Sub

Private Sub Liste(yol As String)
Dim fL As Object, f As Object, Dosya As Object

Set fL = CreateObject("Scripting.FileSystemObject")

For Each Dosya In fL.GetFolder(yol).Files

Uzanti = fL.GetExtensionName(Dosya)
Application.DisplayAlerts = False
If ThisWorkbook.Name <> Dosya.Name And fL.GetFile(Dosya).Type = "Microsoft Excel Çalışma Sayfası" Then

Dim Katalog As Object, Data As Object, Tablo As Object
Dim son1
Set Data = CreateObject("ADODB.Connection")
Set Katalog = CreateObject("ADOX.Catalog")
Dosya_Yolu = (Dosya)
If Uzanti = "xls" Or Uzanti = "xlsb" Or Uzanti = "xlsx" Or Uzanti = "xlsm" Then

On Error Resume Next

If Uzanti = "xls" Then
Data.Open "Driver={Microsoft Excel Driver (*.xls)};Dbq=" & Dosya_Yolu & ";"
Else
Data.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};Dbq=" & Dosya_Yolu & ";"
End If


Katalog.ActiveConnection = Data
For Each Tablo In Katalog.Tables
If InStr(1, Tablo.Type, "TABLE") > 0 Then
If Right(Tablo.Name, 19) <> "kaynağından_sorgula" Then
If Right(Tablo.Name, 14) <> "Yazdırma_Alanı" Then
son1 = Replace(Tablo.Name, "'", "")
If Right(son1, 1) <> "_" Then
If Right(son1, 1) = "$" Then

sat1 = ListBox1.ListCount
ListBox1.AddItem
ListBox1.List(sat1, 0) = Left$(son1, Len(son1) - 1)
ListBox1.List(sat1, 1) = Dosya.Name
ListBox1.List(sat1, 2) = Dosya

End If
End If
End If
End If
End If
Next
Set Data = Nothing
Set Katalog = Nothing

End If
End If

Next

On Error GoTo sonraki
For Each f In fL.GetFolder(yol).SubFolders
Kaynak = f.Path

Liste (Kaynak)
sonraki:
Next

Set fL = Nothing
End Sub

Merhaba Üstad,

Sıkıştırılmış dosyada sorun var sanırım açılmıyor.

 

[halit3]

Kod rar ve zıp uzantılı dosyalarda çalışmaz