Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Beyin Fırtınası
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Beyin Fırtınası Bu başlıkta, ilginç olduğunu düşündüğünüz sorularınızı, bir problem şeklinde sorabilir, alternatif olduğunu düşündüğünüz çözümlerinizi paylaşabilirsiniz. (Bu başlıkta yeni konu açılması onaya bağlıdır.)
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 16-12-2011, 12:55   #11
bezl
 
Giriş: 03/05/2005
Mesaj: 453
Excel Vers. ve Dili:
2010 - Eng
Varsayılan

Merhaba bir klasör içindeki dosyaları ve sadece o klasörün içindeki klasörleri listeletebilir miyiz. Buradaki çalışmalardan yola çıkarak yapmaya çalıştım ama olmadı. Yardımcı olursanız sevinirim.
bezl Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-12-2011, 13:14   #12
halit3
Uzman
 
halit3 kullanıcısının avatarı
 
Giriş: 18/01/2008
Mesaj: 10,473
Excel Vers. ve Dili:
2003 excel türkçe
Varsayılan

Alıntı:
bezl tarafından gönderildi Mesajı Görüntüle
Merhaba bir klasör içindeki dosyaları ve sadece o klasörün içindeki klasörleri listeletebilir miyiz. Buradaki çalışmalardan yola çıkarak yapmaya çalıştım ama olmadı. Yardımcı olursanız sevinirim.
9 nolu mesajdaki kod sadece klasörün içindeki dosyaları listaliyor.

4 nolu mesejdaki kodun aşağıdaki bölümünü silip denermisiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
On Error GoTo sonraki
For Each f In fL
On Error Resume Next
Liste1 (f.Path)
sonraki:
Next
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
On Error GoTo sonraki
For Each f In fL
On Error Resume Next
Liste2 (f.Path)
sonraki:
Next
__________________





Forum Kuralları
halit3 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-12-2011, 13:22   #13
bezl
 
Giriş: 03/05/2005
Mesaj: 453
Excel Vers. ve Dili:
2010 - Eng
Varsayılan

Dediklerinizi yaptım. Bir klasör içindeki sadece dosyaları alabiyorum zaten. Ama buna bir klasör içindeki sadece altklasörleri olmadan klasörleri nasıl ekleyeceğim.
bezl Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-12-2011, 13:27   #14
halit3
Uzman
 
halit3 kullanıcısının avatarı
 
Giriş: 18/01/2008
Mesaj: 10,473
Excel Vers. ve Dili:
2003 excel türkçe
Varsayılan

Alıntı:
bezl tarafından gönderildi Mesajı Görüntüle
Dediklerinizi yaptım. Bir klasör içindeki sadece dosyaları alabiyorum zaten. Ama buna bir klasör içindeki sadece altklasörleri olmadan klasörleri nasıl ekleyeceğim.
Yukarıdaki mesajımda anlatmaya çalışmıştım kodun kırmızı bölümünü silip denermisiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Columns("A:A").ClearContents
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Liste2 (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste2(Yol As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).subfolders
Dosya = Dir(Yol & "\*.*")
While Dosya <> ""
DoEvents
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
ekle = ""
If Right(Yol, 1) <> "\" Then ekle = "\"
Cells(j, 1) = Yol & ekle & Dosya
Dosya = Dir
Wend
On Error GoTo sonraki
For Each f In fL
On Error Resume Next
Liste2 (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
__________________





Forum Kuralları
halit3 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-12-2011, 13:32   #15
bezl
 
Giriş: 03/05/2005
Mesaj: 453
Excel Vers. ve Dili:
2010 - Eng
Varsayılan

Bunu yaptığınızda sadece o klasör içindeki dosyayı gösteriyor. Bu klasörde 3 tane daha klasör var diyelim. Bunların alt klasörleri olmadan sadece bu 3 klasör adı gelsin istiyorum.
bezl Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-12-2011, 13:40   #16
halit3
Uzman
 
halit3 kullanıcısının avatarı
 
Giriş: 18/01/2008
Mesaj: 10,473
Excel Vers. ve Dili:
2003 excel türkçe
Varsayılan

Alıntı:
bezl tarafından gönderildi Mesajı Görüntüle
Bunu yaptığınızda sadece o klasör içindeki dosyayı gösteriyor. Bu klasörde 3 tane daha klasör var diyelim. Bunların alt klasörleri olmadan sadece bu 3 klasör adı gelsin istiyorum.
Bunu denermisiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Klasör_Listele()
Columns("A:A").ClearContents
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Liste1 (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste1(Yol As String)
Dim j As Long
ekle = ""
If Right(Yol, 1) <> "\" Then ekle = "\"
For Each Klasor In CreateObject("Scripting.FileSystemObject").GetFolder(Yol).subfolders
j = [a65000].End(3).Row + 1
Cells(j, 1) = Yol & ekle & Klasor.Name
Next
End Sub
__________________





Forum Kuralları
halit3 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-12-2011, 13:53   #17
halit3
Uzman
 
halit3 kullanıcısının avatarı
 
Giriş: 18/01/2008
Mesaj: 10,473
Excel Vers. ve Dili:
2003 excel türkçe
Varsayılan

Buda farklı kod

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Klasör_Listele()
Columns("A:A").ClearContents
Set Yol = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Yol Is Nothing Then
Kaynak = Yol.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
If Right(Kaynak, 1) <> "\" Then Kaynak= Kaynak & "\"
End If
For Each Klasor In CreateObject("Scripting.FileSystemObject").GetFolder(Kaynak).subfolders
j = [a65000].End(3).Row + 1
Cells(j, 1) = Kaynak & Klasor.Name
Next
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
__________________





Forum Kuralları
halit3 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-12-2011, 14:25   #18
Bogachank
 
Bogachank kullanıcısının avatarı
 
Giriş: 29/10/2009
Şehir: istanbul
Mesaj: 130
Excel Vers. ve Dili:
2010 ENG-TR
Varsayılan

Merhaba,

Alternatif olarak daha önce Haluk, Hamitcan ve Korhan üstatların yardımları ile derlediğim çalışmayı ekte bilgilerinize sunarım.

Bu vesile ile hocalarımıza tekrar teşekkür ederim.

Saygılarımla.

http://www.excel.web.tr/f48/active-d...23/sayfa3.html

Çalışma 1; Aşağıdaki kod seçilen klasördeki dosyaların dosya adlarını, linklerini ve çeşitli özelliklerini sıralamaktadır.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Public ui As Long
Sub SubHsr()
Dim soru As String
10  If Application.Workbooks.Count = 0 Then
11      soru = "Açık Çalışma Kitabı bulunmamaktadır, yeni çalışma kitabı açılsın mı?"
12      If MsgBox(soru, vbYesNo) = vbYes Then
13          Workbooks.Add: GoTo 18
14      Else
15          MsgBox "Açık çalışma kitabı olmadığından çıklacaktır": GoTo 117
16      End If
17  Else
18      soru = ActiveWorkbook.Name & " kitabının " & ActiveSheet.Name
19      soru = soru & " sayfasına Dosyalar listelenecektir." & vbLf & "Devam Etmek İstiyormusunuz?"
20      If MsgBox(soru, vbYesNo) = vbYes Then
21          GoTo 101
22      Else
23          GoTo 117
24      End If
25  End If
101    Dim klsrSec As Object
102    Dim klsrMsUstu, Dosya, yol As String
103    Set klsrSec = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
104    klsrMsUstu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
105        If klsrSec Is Nothing Then GoTo 117
106        If klsrSec = "Masaüstü" Or Klasor = "Desktop" Then
107            yol = klsrMsUstu
108            AnaListe (yol)
109            AltListe (yol)
110        ElseIf klsrSec <> "Masaüstü" Then
111            yol = klsrSec.Items.Item.Path
112            AnaListe (yol)
113            AltListe (yol)
114        Else
115            GoTo 117
116        End If
117    Set klsrSec = Nothing: ui = 0
End Sub
Private Sub AnaListe(yol As String)
201 Dim Dosya As String
202 Cells.ClearContents
203 Range("A4") = "Dosya Yolu":             Range("B4") = "Dosya Adı"
204 Range("C4") = "Dosya Tipi":             Range("D4") = "Dosya Boyutu"
205 Range("E4") = "Oluşturulma Tarihi":     Range("F4") = "Son Erişim Tarihi"
206 Range("G4") = "Son Düzenleme Tarihi":   Range("H4") = "Son Düzenleme Zamanı"
207 Dosya = Dir(yol & "\*.*")
208 ui = 4
209 While Dosya <> ""
210     DoEvents
211     ui = ui + 1
212     Cells(ui, 1) = yol
213     Cells(ui, 2) = Dosya
214     Call DosyaOzellikleri(yol & Application.PathSeparator & Dosya)
215     Dosya = Dir
216 Wend
End Sub
Private Sub AltListe(yol As String)
On Error Resume Next
301 Dim klsrAra, klsrLst As Object, Dosya, dsyTYl As String
302 Set klsrLst = CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders
303 On Error GoTo 316
304 For Each klsrAra In klsrLst
305     Dosya = Dir(klsrAra.Path & "\*.*")
306     While Dosya <> ""
307        DoEvents
308        ui = [a65000].End(3).Row + 1
309        Cells(ui, 1) = klsrAra.Path & "\"
310        Cells(ui, 2) = Dosya
311        Call DosyaOzellikleri(klsrAra.Path & Application.PathSeparator & Dosya)
312        Dosya = Dir
313     Wend
314     AltListe (klsrAra.Path)
315 Next
316 Set klsrAra = Nothing: Set klsrLst = Nothing
End Sub
Private Sub DosyaOzellikleri(dsyBak As String)
401 Dim DsSisKnt, Dosyam As Object
402 Set DsSisKnt = CreateObject("Scripting.FileSystemObject")
403 Set Dosyam = DsSisKnt.GetFile(dsyBak)
404 With Dosyam
405    ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & ui), Address:=dsyBak
406    Range("C" & ui) = .Type
407    Range("D" & ui) = Format(.Size / 1024, "#,##0.0000") & " Kb"
408    Range("E" & ui) = Format(.DateCreated, "dd.mm.yyyy")
409    Range("F" & ui) = Format(.DateLastAccessed, "dd.mm.yyyy")
410    Range("G" & ui) = Format(.DateLastModified, "dd.mm.yyyy")
411    Range("H" & ui) = Format(.DateLastModified, "hh:mm:ss")
412 End With
413 Set DsSisKnt = Nothing
414 Set Dosyam = Nothing
End Sub
Çalışma 2; Bu kodda ise seçilen yerdeki dosyaların yolunu manuel yazmakla beraber devamında gelen ekranda istediğimiz uzantı tipini ( *.* ; *.xls ; *.doc ; vs... ) şeklinde yazarak arama için uzantı kıstası oluşturabilmekteyiz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Listele()
Dim DTipi$, Klasor$
Klasor = InputBox(" ÖNEMLİ ! : Bulunan değerleri seçili hücreden aşağı doğru yapacağından, doğru sayfa ve doğru hücreyi seçtiğinizden emin olun. Eğer emin değilseniz Cancele basıp çıkın eminseniz, Aşağıya veri girebilirsiniz. " & Chr(13) & "     " & Chr(13) & "Listelenecek yolu yazınız." & Chr(13) & " " & Chr(13) & " Örneğin " & Chr(13) & " D:  " & Chr(13) & "   veya   " & Chr(13) & " C:\Documents and Settings\mozdem\Desktop  ", "Aranacak Dosyaların Yolu ? ")
If Klasor = "" Then End
DTipi = InputBox("Listelenecek dosya türünü yazınız", "Dosya türü ne?", "*.*")
Call ListeAl(Klasor, DTipi, True)
End
End Sub
Sub ListeAl(Klasor$, DTipi$, Alt%)
Dim klasorler(), i, Dosya$, yol$, attr%, ks%
Static r
On Error Resume Next
If Right$(Klasor, 1) <> "\" Then Klasor = Klasor & "\"
If DTipi = "" Then End
Dosya = Dir(Klasor & DTipi, vbNormal)
Do While Dosya <> ""
        yol = Klasor & Dosya
        ActiveCell.Offset(r, 0) = yol
        r = r + 1
        Dosya = Dir()
Loop
If Alt = False Then Exit Sub
Dosya = Dir(Klasor & "*.*", vbDirectory)
Do While Dosya <> ""
    attr = 0
    attr = GetAttr(Klasor & Dosya)
    If Dosya <> "." And Dosya <> ".." And _
        (attr And vbDirectory) <> 0 _
    Then
        ks = ks + 1 'klasör sayısı
        ReDim Preserve klasorler(1 To ks)
        klasorler(ks) = Dosya
    End If
    Dosya = Dir()
Loop

For i = 1 To ks
     Call ListeAl(Klasor & klasorler(i) & "\", DTipi, Alt)
Next i
End Sub
Eklenmiş Dosyalar
Dosya Türü: xls Dosya Listeleme.xls (109.0 KB, 117 Görüntülenme)
__________________
[COLOR=Blue][I][FONT=Comic Sans MS][SIZE=4]Boci...[/SIZE][/FONT]:hihoho:[/I][/COLOR]

Bu mesaj en son " 16-12-2011 " tarihinde saat 16:04 itibariyle Bogachank tarafından düzenlenmiştir.... Neden: Cümle Düzeltme
Bogachank Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-12-2011, 18:28   #19
bezl
 
Giriş: 03/05/2005
Mesaj: 453
Excel Vers. ve Dili:
2010 - Eng
Varsayılan

Çok özür dileyerek seçtiğim klasörün altındaki klasörlerini (bu klasörlerin alt klasörleri hariç) nasıl listeletirim diye yine sormak istiyorum. Verilen cevaplar bütün alt klasörleri listelemek var.
bezl Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-12-2011, 22:24   #20
halit3
Uzman
 
halit3 kullanıcısının avatarı
 
Giriş: 18/01/2008
Mesaj: 10,473
Excel Vers. ve Dili:
2003 excel türkçe
Varsayılan

Alıntı:
bezl tarafından gönderildi Mesajı Görüntüle
Çok özür dileyerek seçtiğim klasörün altındaki klasörlerini (bu klasörlerin alt klasörleri hariç) nasıl listeletirim diye yine sormak istiyorum. Verilen cevaplar bütün alt klasörleri listelemek var.
17 nolu mesajdaki kodu denedinizmi?

Yeni bir dosya oluşturun bu kodu bir modül içine koyup deneyin ve denediğiniz dosyayı buraya ekleyin bir bakalım.
__________________





Forum Kuralları
halit3 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 11:54


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden