- Katılım
- 1 Mart 2005
- Mesajlar
- 22,248
- 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.
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
-
983 bayt Görüntüleme: 53