Dosya değiştirilme tarihini hücreye yazdırma

[jr1453]

Arkadaşlar merhaba. farklı klasörlerde 80 tane excel dosyam var. bunların Windows Gezgininde görünen dosya değiştirilme tarihlerini farklı bi excel'de listeleme kodu lazım. Vardı görmüştüm kitapta ama çıkaramadım şu anda lazım oldu. Aklına gelen yardım edebilir mi?

 

[Haluk]

Merhaba;

Aşağıdaki kodlar, seçilen bir klasör ve alt klasörlerindeki bütün dosyaların ilgili özelliklerini sayfaya yazdırır.

'
'Haluk - 04/07/2018
'
Sub Test()
    Cells.Clear
    
    Range("A1") = "Folder contents::"
    Range("A3") = "File Name:"
    Range("B3") = "File Size:"
    Range("C3") = "File Type:"
    Range("D3") = "Date Created:"
    Range("E3") = "Date Last Accessed:"
    Range("F3") = "Date Last Modified:"
    Range("A1:F3").Font.Bold = True
    
    Set MyFolder = Application.FileDialog(msoFileDialogFolderPicker)
    
    If MyFolder.Show = -1 Then
        Call ListFiles(MyFolder.SelectedItems(1), True)
    End If
End Sub
'
Sub ListFiles(MyFolder As String, IncludeSubfolders As Boolean)
    Dim FSO As Object
    Dim SourceFolder As Object, SubFolder As Object
    Dim FileItem As Object
    Dim r As Long
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(MyFolder)
    
    r = Range("A" & Rows.Count).End(xlUp).Row + 1
    
    For Each FileItem In SourceFolder.Files
        Cells(r, 1) = FileItem.Path & FileItem.Name
        Cells(r, 2) = FileItem.Size
        Cells(r, 3) = FileItem.Type
        Cells(r, 4) = FileItem.DateCreated
        Cells(r, 5) = FileItem.DateLastAccessed
        Cells(r, 6) = FileItem.DateLastModified
        r = r + 1
    Next
    
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            Call ListFiles(SubFolder.Path, True)
        Next
    End If
    
    Columns("A:F").AutoFit
    
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

Eğer alt klasörlere ait bilgileri istemiyorsanız;

Call ListFiles(MyFolder.SelectedItems(1), True)

ifadesindeki True değerini False olarak değiştirin.

.

 

[jr1453]

Teşekkür ederim nezaketiniz için.

 

[Haluk]

Kolay gelsin ...

.

 

[jr1453]

"Folder contents::"

Kolay gelsin ...

.

Hocam sadece bir tane klasörün en son değiştiirlme tarihini istesek ne yazmamız gerekmektedir acaba?

 

[Haluk]

Aşağıdaki kodda MyFolder değişkenindeki "C:\TestFolder" klasörünü kendinize göre değiştirip, kodu deneyiniz.

Sub Test2()
    Dim FSO As Object
    Dim SourceFolder As Object, SubFolder As Object
    Dim FileItem As Object
    Dim r As Long
    
    MyFolder = "C:\TestFolder"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(MyFolder)
    
    'Klasorle ilgili bilgiler
    Range("A1") = SourceFolder.Name
    Range("B1") = SourceFolder.DateLastModified
    
    'Klasordeki dosyalarla ilgili bilgiler
    r = Range("A" & Rows.Count).End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
        Cells(r, 1) = FileItem.Name
        Cells(r, 2) = FileItem.DateLastModified
        r = r + 1
    Next
    
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

.

 

[jr1453]

Kodları aynı yazdım klasörde de xls olan dosyayının adresini tanımladım ancak tepki vermiyor hocam.

 

[Haluk]

Tepki vermiyor ne demek ? Anlamadım ....

-Bilgisayarınızda C:\TestFolder diye bir klasör oluşturup, içine 1-2 tane dosya koydunuz mu?

-Test2 isimli makroyu çalıştırdınız mı?

.

 

[Haluk]

Aşağıdaki animasyonu inceleyin ...



.

 

[jr1453]

Hocam oldu tamda istediğim gibi ama şöyle bir durum var 81 il klasörü var ve ben sadece o klasörden 1 tane excel'in tarihi almak istiyorum klasörde ki tüm dosyalar değil onu nasıl yapabilirim? size müteşekkirim.

 

[jr1453]

Çünkü klasörde farklı exceller'de olcak

 

[Haluk]

Aşağıdaki Test3 isimli makroyu deneyin ....

Kodlardaki C:\TestFolder\Test.xlsm kısmını kendinize göre değiştirin.

Sub Test3()
    'Haluk - 05/07/2018
    Dim FSO As Object
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set MyFile = FSO.GetFile("C:\TestFolder\Test.xlsm")
   
    Range("A1") = MyFile.Name
    Range("B1") = MyFile.DateLastModified
   
    Set MyFile = Nothing
    Set FSO = Nothing
End Sub

.

 

[Lenadro]

Merhaba;

Aşağıdaki kodlar, seçilen bir klasör ve alt klasörlerindeki bütün dosyaların ilgili özelliklerini sayfaya yazdırır.

'
'Haluk - 04/07/2018
'
Sub Test()
    Cells.Clear
   
    Range("A1") = "Folder contents::"
    Range("A3") = "File Name:"
    Range("B3") = "File Size:"
    Range("C3") = "File Type:"
    Range("D3") = "Date Created:"
    Range("E3") = "Date Last Accessed:"
    Range("F3") = "Date Last Modified:"
    Range("A1:F3").Font.Bold = True
   
    Set MyFolder = Application.FileDialog(msoFileDialogFolderPicker)
   
    If MyFolder.Show = -1 Then
        Call ListFiles(MyFolder.SelectedItems(1), True)
    End If
End Sub
'
Sub ListFiles(MyFolder As String, IncludeSubfolders As Boolean)
    Dim FSO As Object
    Dim SourceFolder As Object, SubFolder As Object
    Dim FileItem As Object
    Dim r As Long
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(MyFolder)
   
    r = Range("A" & Rows.Count).End(xlUp).Row + 1
   
    For Each FileItem In SourceFolder.Files
        Cells(r, 1) = FileItem.Path & FileItem.Name
        Cells(r, 2) = FileItem.Size
        Cells(r, 3) = FileItem.Type
        Cells(r, 4) = FileItem.DateCreated
        Cells(r, 5) = FileItem.DateLastAccessed
        Cells(r, 6) = FileItem.DateLastModified
        r = r + 1
    Next
   
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            Call ListFiles(SubFolder.Path, True)
        Next
    End If
   
    Columns("A:F").AutoFit
   
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

Eğer alt klasörlere ait bilgileri istemiyorsanız;

Call ListFiles(MyFolder.SelectedItems(1), True)

ifadesindeki True değerini False olarak değiştirin.

.

@Haluk Bey Merhaba,

Burada Windows Gezgininde görünen yazarlar veya diğer adıyla sahibi kısmını da excele nasıl yazdırabiliriz ?

 

[Lenadro]

@Haluk Bey,

İkinci bir soru olarak bu excel makrosunu video klasörü içerisinde çalıştırdığımızda video uzunluklarını excel içerisine yazdırabilmek mümkün mü?

Örnek olarak değerlendirmek gerekirse aşağıdaki resimde görülen dosya gezgininde yer alan bu bilgilerin hepsini getirmek istiyorum.

 

[Haluk]

Sorgu için arama sonuçları: GetDetailsOf

www.excel.web.tr

.

 

[Lenadro]

Sorgu için arama sonuçları: GetDetailsOf

www.excel.web.tr

.

@Haluk Bey,

Yönlendirmiş olduğunuz sayfa içerisinde kodu buldum ve işimi çözdüm. Şahsınıza çok ama çok teşekkür ederim


#Bilgi Paylaştıkça Kutsaldır#