• DİKKAT

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

Soru Listboxtaki Dosyaları Açma

T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
745
Excel Vers. ve Dili
2016 64 TR
Herkese Merhaba
Listboxta belirlediğim konumdaki dosyaları görüyorum. Ama çift tıkladığımda mevcut konumda dosya yok diyor.

Bir de alt Klasördeki Dosyaları göremiyorum. Ben istiyorum ki seçtiğim konumdan alt klasörler dahil tüm dosyaları görüp çift tıkladığımda açabileyim.
 

Ekli dosyalar

Kod: 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Workbooks.Open yol & "\" & UserForm1.ListBox1.Value
Rem Unload UserForm1
End Sub
Bu kodlarla dosyalar açılıyor ama belirtilen klasörün altındaki alt klasörde bulunan dosyaları görmüyor. Sadece belirtilen klasörün içindeki dosyalar görünüyor. Alt klasörler için yardım edebilecek olan var mı acaba
 
Userformdaki kodları bu şekilde yap.

Kod: 
Private Sub UserForm_Initialize()

Dim fso As Object
yol = "D:\PERSONEL ORTAK\@PBSNet\GÖREVLENDİRME\2020"
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "0;100;0" 'lisbox'taki sütunların genişliği
Set fso = CreateObject("scripting.filesystemobject")
For Each bul In fso.GetFolder(yol).Files
ListBox1.AddItem
sat1 = ListBox1.ListCount - 1
ListBox1.List(sat1, 0) = bul
ListBox1.List(sat1, 1) = bul.Name
Next
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Workbooks.Open UserForm1.ListBox1.List(ListBox1.ListIndex, 0)
Rem Unload UserForm1
End Sub
 
Sayın @halit3 Hocam
Tıklayınca tiff tif pdf jpg jpeg docx ne kadar uzantılı dosya varsa hepsini excel olarak açıyor malesef. Hocam tüm dosyaları kendi formatında açsa bir de işlem yapılan dosyayı kapatmasa Hocam çok mu şey istemiş olurum.
Bir de alt klasörleri görmüyor. Istirham etsem koda bakma imkanınız var mı
 
kod:

Kod: 
Private Sub UserForm_Initialize()
yol = "D:\PERSONEL ORTAK\@PBSNet\GÖREVLENDİRME\2020"
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "0;100;0" 'lisbox'taki sütunların genişliği
Liste (yol)
End Sub

Private Sub Liste(yol As String)
Dim fL As Object, fs As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject")

For Each Dosya In fL.GetFolder(yol).Files
ListBox1.AddItem
sat1 = ListBox1.ListCount - 1
ListBox1.List(sat1, 0) = Dosya
ListBox1.List(sat1, 1) = Dosya.Name
Next

On Error GoTo sonraki
For Each f In fL.GetFolder(yol).subfolders
Liste (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dosya1 = ListBox1.List(ListBox1.ListIndex, 0)
If Dosya 1<> "" Then
CreateObject("Shell.Application").Open (Dosya1)
End If
End Sub
 
Sayın @halit3 Hocam çok teşekkür ederim. Elinize emeğinize sağlık
Sadece excel dosyalarını açmıyor. Sistemsel bir sorun mu bilmiyorum. Excel türü dosyaların hiçbiri açılmıyor .
 
Son düzenleme:
Userformun ShowModal özelliğini False yap ondan sonra dene
 
Arkadaşlar Merhaba;
Dosyada Listbox1 e belirtilen yoldaki dosyaları getirmeyi ve açmayı Sayın @halit3 Beyin yardımı ile yaptım. Kendisine çok teşekkür ederim.
Faydalanmak isteyenler için de dosyayı paylaşıyorum.

Dosyalar listbox1 e geliyor ve tıklanınca açılıyor. Bu sefer de söyle bir şeye ihtiyaç oldu ki :

Listboxta çok fazla dosya olunca arama bulma yönetimine ihtiyacım var
Şöyle ki TextBox1 e yazdığım kelimeyi listbox1 de bulup süzsün
Misal Abdulhakim AVRASİ-123.pdf İsimli dosyayı

rasi yazdığımda da
hakim yazdığımda da
Abd yazdığımda da
Abdulhakim yazdığımda da
avrasi yazdığımda da
DULHA yazdığımda da
123 yazdığımda da

büyük küçük harf ayrımı yapmaksızın arayıp süzüp getirsin.

yine *.pdf yazdığımda tüm pdf uzantılı dosyaları
*.tiff yazdığımda tüm tiff uzantılı dosyaları
*.docx yazdığımda tüm docx uzantılı dosyaları
*.jpeg yazdığımda tüm jpeg uzantılı dosyaları
*.xlsx yazdığımda tüm xlsx uzantılı dosyaları süzüp getirmesi için yardım edebilecek olan var mı acaba
 

Ekli dosyalar

Kod

Kod: 
Private Sub UserForm_Initialize()
yol = "C:\Users\YILDIZ\Desktop\ULUSLARARASI İLİŞKİLER"
'yol = ThisWorkbook.Path & "\"
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "0;100;0" 'lisbox'taki sütunların genişliği
Liste (yol)
End Sub

Private Sub Liste(yol As String)
Dim fL As Object, fs As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject")

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

If ThisWorkbook.Name <> Dosya.Name Then
If Mid(Dosya.Name, 1, 2) <> "~$" Then
ListBox1.AddItem
sat1 = ListBox1.ListCount - 1
ListBox1.List(sat1, 0) = Dosya
ListBox1.List(sat1, 1) = Dosya.Name
End If
End If
Next

On Error GoTo sonraki
For Each f In fL.getfolder(yol).subfolders
Liste (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dosya1 = ListBox1.List(ListBox1.ListIndex, 0)
If Dosya1 <> "" Then
CreateObject("Shell.Application").Open (Dosya1)
End If
End Sub

Private Sub TextBox1_Change()
yol = "C:\Users\YILDIZ\Desktop\ULUSLARARASI İLİŞKİLER"
'yol = ThisWorkbook.Path & "\"
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "0;100;0" 'lisbox'taki sütunların genişliği
Liste2 (yol)

End Sub

Private Sub Liste2(yol As String)
Dim fL As Object, fs As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject")

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

If ThisWorkbook.Name <> Dosya.Name Then
If Mid(Dosya.Name, 1, 2) <> "~$" Then
If UCase(Dosya.Name) Like "*" & UCase(Replace(Replace(TextBox1, "i", "İ"), "ı", "I")) & "*" Then

ListBox1.AddItem
sat1 = ListBox1.ListCount - 1
ListBox1.List(sat1, 0) = Dosya
ListBox1.List(sat1, 1) = Dosya.Name
End If
End If
End If
Next

On Error GoTo sonraki
For Each f In fL.getfolder(yol).subfolders
Liste2 (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub
 
halit3' Alıntı:
Kod

Kod: 
Private Sub UserForm_Initialize()
yol = "C:\Users\YILDIZ\Desktop\ULUSLARARASI İLİŞKİLER"
'yol = ThisWorkbook.Path & "\"
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "0;100;0" 'lisbox'taki sütunların genişliği
Liste (yol)
End Sub

Private Sub Liste(yol As String)
Dim fL As Object, fs As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject")

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

If ThisWorkbook.Name <> Dosya.Name Then
If Mid(Dosya.Name, 1, 2) <> "~$" Then
ListBox1.AddItem
sat1 = ListBox1.ListCount - 1
ListBox1.List(sat1, 0) = Dosya
ListBox1.List(sat1, 1) = Dosya.Name
End If
End If
Next

On Error GoTo sonraki
For Each f In fL.getfolder(yol).subfolders
Liste (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dosya1 = ListBox1.List(ListBox1.ListIndex, 0)
If Dosya1 <> "" Then
CreateObject("Shell.Application").Open (Dosya1)
End If
End Sub

Private Sub TextBox1_Change()
yol = "C:\Users\YILDIZ\Desktop\ULUSLARARASI İLİŞKİLER"
'yol = ThisWorkbook.Path & "\"
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "0;100;0" 'lisbox'taki sütunların genişliği
Liste2 (yol)

End Sub

Private Sub Liste2(yol As String)
Dim fL As Object, fs As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject")

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

If ThisWorkbook.Name <> Dosya.Name Then
If Mid(Dosya.Name, 1, 2) <> "~$" Then
If UCase(Dosya.Name) Like "*" & UCase(Replace(Replace(TextBox1, "i", "İ"), "ı", "I")) & "*" Then

ListBox1.AddItem
sat1 = ListBox1.ListCount - 1
ListBox1.List(sat1, 0) = Dosya
ListBox1.List(sat1, 1) = Dosya.Name
End If
End If
End If
Next

On Error GoTo sonraki
For Each f In fL.getfolder(yol).subfolders
Liste2 (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub
Genişletmek için tıkla ...
Sayın @halit3 Halit Hocam kod çalışıyor ama o kadar ağır çalışıyor ki textbox1 e yazdigimi 20 saniyeden saha uzun sürede yazıyor textbox1 e .
Textbox1 de yazanı silmek istediğimde de 20 saniyeden daha uzun bir sürede textbox1 i temizliyor. Kodu hızlandırma imkanınız var mı bu şekilde çok ağır çalışıyor
 
Sayfanızda formüller çok varsa kod yavaşlar
geçmiş zamanda da size yazdığım kodlar vardı hesaplamaları makro çalıştığında manuel yapacak işlem bittiğinde otomatiğe çevirecek
bu kodları eklerseniz kod hızlanacaktır.
 
Sayın @halit3 Halit Hocam
Arama yaparken i harfinde sorun çıkarıyor.
Bir de arama dosya sayısına bağlı olarak uzuyor. Ama 100 tane dosya için de süre uzun ama .
 
halit3' Alıntı:
Sayfanızda formüller çok varsa kod yavaşlar
geçmiş zamanda da size yazdığım kodlar vardı hesaplamaları makro çalıştığında manuel yapacak işlem bittiğinde otomatiğe çevirecek
bu kodları eklerseniz kod hızlanacaktır.
Genişletmek için tıkla ...
Hocam excel sayfasinda sadece bu userform var. Hızlandirmak icin Geçmişte yazdınız kodlar derken inanin hatırlayamadım. Kodları Nasıl nerden alıp hizlandiracagimi bilemedim. Yardımcı olursanız çok sevinirim.
Bir de dosya uzantısı ve ya adı
.ini büyük küçük i harfi ile yazdıysam da bulmadı. I ve i harfinde sorun çıkarıyor.
 
yol = "C:\Users\YILDIZ\Desktop\ULUSLARARASI İLİŞKİLER"

Bu bölümde yaklaşık kaç dosya mevcut
Kodlar aksanlı harflerde ve türkçe karekterlerde sorun çıkartır
 
Farklı bir konu başlığında da benzer sorunuz vardı
Kod bir klasörde veya bir sürücüde çalıştırılıyor ise buradaki dosya sayısı ile hızı orantılı olacaktır.
 
TURKOLOG' Alıntı:
460 dosya vaR belirttiğim konumda Hocam
Genişletmek için tıkla ...

Textbox1 e her yazı karekteri eklediğinizde veya sildiğinizde bu 460 dosyayı tarayacaktır kod
siz en iyisi bu bölümü bir komut düğmesine atayın. ve oradan çalıştırın

Kod: 
Private Sub TextBox1_Change()
yol = "C:\Users\YILDIZ\Desktop\ULUSLARARASI İLİŞKİLER"
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "0;100;0" 'lisbox'taki sütunların genişliği
Liste2 (yol)

End Sub
 
halit3' Alıntı:
Textbox1 e her yazı karekteri eklediğinizde veya sildiğinizde bu 460 dosyayı tarayacaktır kod
siz en iyisi bu bölümü bir komut düğmesine atayın. ve oradan çalıştırın

Kod: 
Private Sub TextBox1_Change()
yol = "C:\Users\YILDIZ\Desktop\ULUSLARARASI İLİŞKİLER"
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "0;100;0" 'lisbox'taki sütunların genişliği
Liste2 (yol)

End Sub
Genişletmek için tıkla ...
Tamam Hocam dediginiz gibi butona ekleyeyim . Ama i I İ olayı kalacak o zaman
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst