• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan halit3
  • Başlangıç tarihi Başlangıç tarihi
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,876
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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.
 

Ekli dosyalar

Son düzenleme:
Sayın halit3, merhaba,

Paylaşımınız için teşekkürler...
 
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


halit3' Alıntı:
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.
Genişletmek için tıkla ...
 
Dosyaya 1adet userform3 ekledim. kod:

Rich (BB code): 
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
 

Ekli dosyalar

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

İyi çalışmalar


Tapatalk kullanarak iPhone aracılığıyla gönderildi
 
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.
 

Ekli dosyalar

Kod: 
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.

Kod: 
If ThisWorkbook.Name <> Dosya.Name Then
 
Üstadım gerekli düzeltmeyi yaptım, olumlu bir sonuç alamadım.

Dosyam ilişiktedir.
 

Ekli dosyalar

  • SOR.rar
    SOR.rar
    57.4 KB · Görüntüleme: 14
Dosya boyutu büyük olduğu ve daha önce yüklediğim dosyanın silindiğini fark etmem üzerine, yukarıdaki dosyayı ekledim.
 
Son düzenleme:
12 nolu mesajdaki dosyanızı indirdim kodlar bende çalışıyor.
 
Ü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.
 

Ekli dosyalar

Userform1 silin userform3 kullanın kodlar bir birinin benzerleri
 
Sorun, Office 15 sürümünü kullanmamdan kaynaklanabilir mi?
 
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.
 
Son düzenleme:
halit3' Alıntı:
Dosyaya 1adet userform3 ekledim. kod:

Rich (BB code): 
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
Genişletmek için tıkla ...


Merhaba Üstad,

Sıkıştırılmış dosyada sorun var sanırım açılmıyor.
 
Kod rar ve zıp uzantılı dosyalarda çalışmaz
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst