Arşiv Dosyalarının Verilerini Excel de toplamak

[lev_sez]

Merhabalar,

Yapmak istediğimi sitedeki bir çok örneği okuyarak yapmaya çalıştım fakat bir türlü oluşturamadım.

Film arşivimdeki tüm filmleri Excel dosyasında toplamak istiyorum. Her filmin ismini, dosya türünü ve dosya boyutunu nasıl excel e aktarabilirim yardımcı olabilir misiniz?

Ekteki dosyada örnekleme yaptım. Yardımlarınızı rica ediyorum.

 

[Necdet]

Merhaba,

Aşağıdaki kodları kullanabilirsiniz.

Dim iRow
Dim iCol
 
'Kodların alındığı site
'http://excelexperts.com/VBA-Tips-List-Files-In-A-Folder

'Referanslardan Microsoft Scripting Runtime Seçili olmalı
Sub ListFiles()
    
    Dim Yol As String
    
    Application.ScreenUpdating = True
    Yol = KlasorSec
    If Yol = "" Then Exit Sub
    
    Yol = Yol & Application.PathSeparator
    iRow = Cells(Rows.Count, "A").End(3).Row
    If iRow < 2 Then iRow = 2
    Range("A2:A" & iRow).ClearContents
    
    iRow = 2
    
    Call ListMyFiles(Yol, "True")
    Cells.EntireColumn.AutoFit
    
    Application.ScreenUpdating = False
    
End Sub

Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Dim MyObject
    Dim mySource
    Dim myFile
    Dim mySubFolder
    Dim j As Integer
    Dim Dosya
    
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    On Error Resume Next
    
    For Each myFile In mySource.Files
        
        For j = 1 To Len(myFile.Name)
            If IsNumeric(Mid(myFile.Name, j, 2)) = True Then Exit For
        Next j
        If Mid(myFile.Name, j - 1, 1) = "." Then j = j - 1
        Cells(iRow, "A") = Left(myFile.Name, j - 1)
        Dosya = Split(myFile, ".")
        
        Cells(iRow, "B") = Dosya(UBound(Dosya))
        Cells(iRow, "C").Value = myFile.Size
        iRow = iRow + 1
    Next
    
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True)
        Next
    End If
    
End Sub

Function KlasorSec() As String
    Dim ObjFolder   As Variant
 
    Set ObjFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
 
    If Not ObjFolder Is Nothing Then
        KlasorSec = ObjFolder.Items.Item.Path
    Else
        KlasorSec = ""
    End If
End Function

 

[lev_sez]

Çok teşekkürler katkılarınızdan dolayı.

Tüm verileri alıyor fakat dosya ismini aktarmıyor. Onu nasıl aktif hale getirebilirim?

 

[Asri]

Çok teşekkürler katkılarınızdan dolayı.

Tüm verileri alıyor fakat dosya ismini aktarmıyor. Onu nasıl aktif hale getirebilirim?

Dosya uzantısını alma ile ilgili düzenleme yapıldı.
bir den fazla nokta olan yada ilk karakteri nokta olan dosya isimlerine göre ayarlandı.

 

[lev_sez]

ellerinize sağlık