Disk İçeriği

[ikaros]

Merhabalar,
4 Tb taşınabilir diskim var içi çok dolu .İçindekileri en alta kadar döküm almak istiyorum.Bu konuda yardım ve önerilerini rica ediyorum.Teşekkürler...

 

[Emir Hüseyin Çoban]

.

Dim c
Dim sütun_kolon

Sub ALT_Klasörleri_Listele()

    Yol = "C:\Users\huseyincoban\Desktop"
        Dim s1 As Worksheet: Set s1 = Sheets(ActiveSheet.Name)
    sütun_kolon = 1 'Range("sütun_adres").Column
    başlangıç_satırı = 1 ' Range("başlangıç_satırı").Row


    s1.Columns(sütun_kolon).ClearContents
    c = başlangıç_satırı - 1
    klasoradi = Yol
    Liste2 (klasoradi)
End Sub

Private Sub Liste2(Yol As String)
    Dim s1 As Worksheet: Set s1 = Sheets("LİSTE")
    Set nesne = CreateObject("Scripting.FileSystemObject")
    
    dosyasayisi = nesne.GetFolder(Yol).Files.Count
    klasorsayisi = nesne.GetFolder(Yol).SubFolders.Count

    If dosyasayisi > 0 Then
        For Each dosya In nesne.GetFolder(Yol).Files
            c = c + 1
            s1.Cells(c, sütun_kolon) = Yol & "\" & dosya.Name
        Next
    End If
    If klasorsayisi > 0 Then
        For Each altklasor In nesne.GetFolder(Yol).SubFolders
            Liste2 (altklasor)
        Next
    End If
End Sub

.

 

[ikaros]

.

Dim c
Dim sütun_kolon

Sub ALT_Klasörleri_Listele()

    Yol = "C:\Users\huseyincoban\Desktop"
        Dim s1 As Worksheet: Set s1 = Sheets(ActiveSheet.Name)
    sütun_kolon = 1 'Range("sütun_adres").Column
    başlangıç_satırı = 1 ' Range("başlangıç_satırı").Row


    s1.Columns(sütun_kolon).ClearContents
    c = başlangıç_satırı - 1
    klasoradi = Yol
    Liste2 (klasoradi)
End Sub

Private Sub Liste2(Yol As String)
    Dim s1 As Worksheet: Set s1 = Sheets("LİSTE")
    Set nesne = CreateObject("Scripting.FileSystemObject")
   
    dosyasayisi = nesne.GetFolder(Yol).Files.Count
    klasorsayisi = nesne.GetFolder(Yol).SubFolders.Count

    If dosyasayisi > 0 Then
        For Each dosya In nesne.GetFolder(Yol).Files
            c = c + 1
            s1.Cells(c, sütun_kolon) = Yol & "\" & dosya.Name
        Next
    End If
    If klasorsayisi > 0 Then
        For Each altklasor In nesne.GetFolder(Yol).SubFolders
            Liste2 (altklasor)
        Next
    End If
End Sub

.

İlginize çok teşekkür ederim.Ben az düzeyde excel biliyorum.Bu visual basicte mi yapılacak.Yol gösterirmisiniz lütfen ...Kolay gelsin...

 

[Emir Hüseyin Çoban]

.

Önce güvenlik ayarlarından makroları etkinleştirin. Google, Youtube da anlatımları mevcut.

Yeni bir excel sayfası açıp, Sayfa1 yazan sekmek isminde sağ tıklayıp > Kodları görüntüle >
VBA penceresi açılacaktır.
İnsert > Module >
Açılan sayfaya yukarıdaki kodları yapıştırın.

Yol = "C:\Users\huseyincoban\Desktop"
buradaki tırnak arasına sizin istediğiniz ana dosya yolunu yazın.

Mouse imleci yol satırının üzerindeyken klavyeden F5 basarak kodları çalıştırın.

.

 

[ikaros]

.

Önce güvenlik ayarlarından makroları etkinleştirin. Google, Youtube da anlatımları mevcut.

Yeni bir excel sayfası açıp, Sayfa1 yazan sekmek isminde sağ tıklayıp > Kodları görüntüle >
VBA penceresi açılacaktır.
İnsert > Module >
Açılan sayfaya yukarıdaki kodları yapıştırın.

Yol = "C:\Users\huseyincoban\Desktop"
buradaki tırnak arasına sizin istediğiniz ana dosya yolunu yazın.

Mouse imleci yol satırının üzerindeyken klavyeden F5 basarak kodları çalıştırın.

.

İnsert > Module > den sonra
Dim c
Dim sütun_kolon
başlayan kısımı mı yapıştıracağım ve yol kısmını değiştirip F5'e basacağım ? Denedim olmadı çook teşekkür ederim.

 

[Emir Hüseyin Çoban]

.

Google dan excel vba modül ekleme
makro kodları çalıştırma gibi anahtar kelimelerle araştırma yapınız.

.