Vbscript ile İstediğiniz herhangi bir klasördeki dosyaların listesi

[Orion1]

Merhaba arkadaşlar.
Vbscript ile istediğiniz herhangi bir klasördeki dosyaların toplam adedini bulabilir.Uzantılarına göre adedlerini listeleyebilir ve tüm dökümünü alabilirsiniz.
vbs dosyası oluşturmak için notepad ile bir dosya açın ve içine kodlarınızı yazın adını yazdıktan sonar uzantısını vbs olarak girin ve kaydedip kapatın.VBS dosyanız hazırdır.
Vbs dosaysının içini görmek için ise dosyaya sağ tıklayın.Birlikte açın dan notepad seçin açılacaktır.
Güle güle kullann.
Kodlar aşağıda ve dosyada ektedir.
call dosyalar
sub dosyalar
Set yol = CreateObject("Shell.Application").BrowseForFolder(0, _
"Taranacak klasörü seçin", 0)
If yol Is Nothing Then Exit Sub

set z = createobject("Scripting.Dictionary")
set fso = createobject("Scripting.FileSystemObject")
set dosya = fso.getfolder(yol.items.Item.Path).files
y=yol.items.Item.Path
redim d(dosya.count)
for each j in dosya
i=i+1
d(i) = j.name

f = ucase(replace(replace(fso.GetExtensionName(j),"ı","I"),"i","İ"))
if not z.exists(f) then
z.add f,1
else
z.item(f)=z.item(f)+1
end if
next

for i = 1 to dosya.count-1
for j = i+1 to dosya.count
if strcomp(d(i),d(j), vbTextCompare) = 1 Then
x=d(i)
d(i)=d(j)
d(j)=x
end if
next
next

Const ForReading = 1, ForWriting = 2
Dim f
yol = fso.GetAbsolutePathName("")
Set f = fso.OpenTextFile(yol & "\evren_dosya_listesi.txt", ForWriting, True)
f.WriteBlankLines 2
f.WriteLine "================================================== ==============================================="
f.writeblanklines 1
f.writeline " H A Z I R L A Y A N E V R E N G İ Z L E N 28.09.2009 "
f.writeline ""
f.writeline "Bu dosya İle Seçtiğiniz Klasördeki dosyaları listeler ve cinsine göre adedini bulabilirsiniz"
f.writeline ""
f.writeline "================================================== ==============================================="
f.WriteBlankLines 2
f.writeline "KLASÖR : " & vbtab & y
f.WriteBlankLines 2
f.writeline "TOPLAM DOSYA ADEDİ :" & vbtab & dosya.count
f.WriteBlankLines 2
'Set f = fs.OpenTextFile("C:\testfile.txt", ForReading)
'WriteBlankLinesToFile = f.ReadAll
say=1
for each vkey in z.keys
f.writeline say & vbtab & vkey & vbtab & z.item(vkey)
say=say +1
next
f.WriteBlankLines 2
F.Writeline "================================================== ===================================="
f.WriteBlankLines 2
for i = 1 to dosya.count
deg= i & vbtab & d(i)
f.WriteLine deg
deg=""
next
CreateObject("Shell.Application").Open yol & "\evren_dosya_listesi.txt"
end sub

[Orion1]

Dosya boyutlarını ve oluşturuldukları tarihleride göstericek şekilde düzenledim.
Dosya ektedir.:cool: