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

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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.
Kod:
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
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosya boyutlarını ve oluşturuldukları tarihleride göstericek şekilde düzenledim.
Dosya ektedir.:cool:
 

Ekli dosyalar

Üst