Merhaba,
Aşağıda ki kodlar ile sabit olarak belirttiğim C:\cim klasörü içerisinde ki dosya isimlerini alıyorum. Kodu yine bu siteden alıp kendimce uyarlamaya çalıştım. Ancak cim klasörü içerisinde binlerce dosya bulunmakta. Ben sadece son iki günde oluşturulan dosyalar veya da son 50 dosya gibi bir kısıt ile hız kazanmak istiyorum.Kodun içerisinde ki
satırı ile veri almadan geç dedim ancak yine de binlerce dosyayı tek tek gezip tarihine baktığı için yine yavaş oldu. Aslında istediğim şu da olabilir; Veri almaya eski tarihlerden değilde son oluşturulanlar dan başlarsa for döngüsünü 50 ye kadar yapar ve çözbilirim. Ancak yeni tarihlilerden başlamak kısmında da işin içinden çıkamadım.
Yardımcı olabilecek arkadaşlara şimdiden çok teşekkür ederim.
Kod şu şekildedir;
Aşağıda ki kodlar ile sabit olarak belirttiğim C:\cim klasörü içerisinde ki dosya isimlerini alıyorum. Kodu yine bu siteden alıp kendimce uyarlamaya çalıştım. Ancak cim klasörü içerisinde binlerce dosya bulunmakta. Ben sadece son iki günde oluşturulan dosyalar veya da son 50 dosya gibi bir kısıt ile hız kazanmak istiyorum.Kodun içerisinde ki
Kod:
If CDate(Format(CreateObject("Scripting.FileSystemObject").GetFile(yol & "\" & Dosya).DateCreated, "dd.mm.yyyy")) < CDate(Date - 2) Then GoTo 1Yardımcı olabilecek arkadaşlara şimdiden çok teşekkür ederim.
Kod şu şekildedir;
Kod:
Public sat As Long
Option Private Module
Sub dosyaListele()
Set s1 = ThisWorkbook.Sheets("Sayfa2")
Kaynak = "C:\cim"
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
s1.Cells.ClearContents
s1.Range("A1") = "Dosya Yolu"
s1.Range("B1") = "Dosya Adı"
s1.Range("C1") = "Dosya Tipi"
s1.Range("D1") = "Dosya Boyutu"
s1.Range("E1") = "Oluşturulma Tarihi"
s1.Range("F1") = "Son Erişim Tarihi"
s1.Range("G1") = "Son Düzenleme Tarihi"
s1.Range("H1") = "Son Düzenleme Zamanı"
AltListe (Kaynak)
MsgBox "işlem tamam !", vbInformation, "DİKKAT"
Atla:
Set Obj = Nothing
Set klasor = Nothing
Exit Sub
Hata: MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
End Sub
Private Sub AltListe(yol As String)
Dim klsrAra, klsrLst As Object, Dosya
Set s1 = ThisWorkbook.Sheets("Sayfa2")
Set klsrLst = CreateObject("Scripting.FileSystemObject").GetFolder(yol).subfolders
Dosya = Dir(yol & "\*.*")
Set nesne = CreateObject("Scripting.FileSystemObject")
Set klasor = nesne.GetFolder(yol)
Set dosyalar = klasor.Files
dosyasayısı = dosyalar.Count
For i = 1 To dosyasayısı
DoEvents
If CDate(Format(CreateObject("Scripting.FileSystemObject").GetFile(yol & "\" & Dosya).DateCreated, "dd.mm.yyyy")) < CDate(Date - 2) Then GoTo 1
sat = s1.[B65000].End(3).Row + 1
s1.Cells(sat, 2) = Dosya
On Error Resume Next
With CreateObject("Scripting.FileSystemObject").GetFile(yol & "\" & Dosya)
s1.Range("C" & sat) = .Type
s1.Range("E" & sat) = Format(.DateCreated, "dd.mm.yyyy")
End With
1:
Dosya = Dir
Next i
On Error GoTo sonraki
sonraki:
End Sub
