Soru Bir klasörü listelememek

seckinb

Altın Üye
Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Merhaba,

bir klasör içindeki tüm *.xlsm dosyalarını listeliyorum.
acaba listelemek için kullandığım bu koda
"000_Sablon" klasörü hariç diye bir seçenek koyabilir miyim?


PHP:
Private Sub GetFilesInFolder(ByVal SourceFolderName As String, ByVal Subfolders As Boolean)

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = fs.GetFolder(SourceFolderName)
    Set s1 = ThisWorkbook.Worksheets("hiper")

    r = s1.Range("A" & s1.Rows.Count).End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
     If Not FileItem.Name Like "~*" And Not FileItem.Path = ThisWorkbook.FullName And FileItem.Name Like "*.xlsm" Then
        s1.Cells(r, 1).Formula = FileItem.Path
        r = r + 1
     End If
    Next FileItem

    If Subfolders = True Then
        For Each SubFolder In SourceFolder.Subfolders
            GetFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set fs = Nothing
End Sub
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,553
Excel Vers. ve Dili
Pro Plus 2021
İlk satırın altına ekleyip deneyin.
Kod:
    If InStr(SourceFolderName, "000_Sablon") Then Exit Sub
 

seckinb

Altın Üye
Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Gayet güzel çalıştı.
instr fonksiyonu bu noktada "klasör şu ise dosyaları tarama" demek istiyor anladığım kadarıyla.
teşekkürler :)

Sadece subfolders ve onun subfolderları içindeki xslm dosyalarını listelemesini nasıl sağlarız?
mesela ana path dosyasında 1-2 tane konu ile ilişkisiz xslm dosyası var.
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,553
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Private Sub GetFilesInFolder(ByVal SourceFolderName As String, ByVal Subfolders As Boolean, ByRef dic)

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set sourcefolder = fs.GetFolder(SourceFolderName)
    Set s1 = ThisWorkbook.Worksheets("hiper")

    If dic.exists(sourcefolder.Name) Then GoTo atla
    r = s1.Range("A" & s1.Rows.Count).End(xlUp).Row + 1
    For Each FileItem In sourcefolder.Files
        If Not FileItem.Name Like "~*" And Not FileItem.Path = ThisWorkbook.FullName And FileItem.Name Like "*.xls*" Then
            s1.Cells(r, 1).Formula = FileItem.Path
            r = r + 1
        End If
    Next FileItem
atla:
    If Subfolders = True Then
        For Each subfolder In sourcefolder.Subfolders
            GetFilesInFolder subfolder.Path, True, dic
        Next subfolder
    End If

    Set FileItem = Nothing
    Set sourcefolder = Nothing
    Set fs = Nothing

End Sub

Sub test()
    [a:a].ClearContents
    Set dic = CreateObject("Scripting.Dictionary")
    dic.Item("Power-Query-examples") = Null
    dic.Item("000_Sablon") = Null
    GetFilesInFolder "C:\Users\pc\Desktop\Power-Query-examples", True, dic
End Sub
 

seckinb

Altın Üye
Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
C:\Users\pc\Desktop\Power-Query-examples

bu adres nereye denk geliyor?

Power-Query-examples nedir?

öğrenmek adına soruyorum :)
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,553
Excel Vers. ve Dili
Pro Plus 2021
bir klasör içindeki tüm *.xlsm dosyalarını listeliyorum.
acaba listelemek için kullandığım bu koda
"000_Sablon" klasörü hariç diye bir seçenek koyabilir miyim?
bahsettiğiniz bir klasörün adresini buraya yazacaksınız.
Kod:
Sub test()
    [a:a].ClearContents
    Set dic = CreateObject("Scripting.Dictionary")
    dic.Item("Klasörİsmi") = Null
    dic.Item("000_Sablon") = Null
    GetFilesInFolder "C:\Users\pc\Desktop\Klasörİsmi", True, dic
End Sub
 

seckinb

Altın Üye
Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
bahsettiğiniz bir klasörün adresini buraya yazacaksınız.
Kod:
Sub test()
    [a:a].ClearContents
    Set dic = CreateObject("Scripting.Dictionary")
    dic.Item("Klasörİsmi") = Null
    dic.Item("000_Sablon") = Null
    GetFilesInFolder "C:\Users\pc\Desktop\Klasörİsmi", True, dic
End Sub

benim söylemek istediğim "activeworkbook.path" listelenmesin, sadece onun subfolderları listelensin.
 
Üst