- Konum
- BERTUNA
-
- Üyelik Tarihi
- 2 Haz 2020
-
- Mesajlar
- 5,338
-
- MFC Puanı
- 16,230
Merhabalar
Uzun zamandır (2-3 gündür) üzerinde uğraştığım bir .vbs betiğini bu gece bitirdim Allah'a(c.c) şükürler olsun.
Direk Ekran Görüntülerini veriyorum...
[align=center]
[/align]
Kodlama İçeri :
Güle güle kullanın....
[align=center]TRWE_2012
Alaydan Yetişme PC Kullanıcısı[/align]
Uzun zamandır (2-3 gündür) üzerinde uğraştığım bir .vbs betiğini bu gece bitirdim Allah'a(c.c) şükürler olsun.
Direk Ekran Görüntülerini veriyorum...
[align=center]
Kodlama İçeri :
Kod:
' Shell nesnesini oluştur
Set objShell = CreateObject("Shell.Application")
' Dosya açma diyalog penceresini göster
Set objFolder = objShell.BrowseForFolder(0, "Bir dizin seçin:", 0)
' Kullanıcı iptal ederse scripti sonlandır
If objFolder Is Nothing Then
Wscript.Quit
End If
' Seçilen dizinin yolunu al
Dim selectedPath
selectedPath = objFolder.Self.Path
' Dosya sistem nesnesini oluştur
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Dosya ve dizin listesini tutacak değişkenler
Dim fileList
fileList = ""
Dim folderCount
folderCount = 0
Dim totalSize
totalSize = 0 ' Toplam boyut değişkeni
' Rekürsif fonksiyon tanımı
Sub ListFilesInFolder(folder)
Dim file
Dim subfolder
' Dosyaları listele ve boyutlarını topla
For Each file In folder.Files
fileList = fileList & file.Path & vbCrLf
totalSize = totalSize + file.Size ' Dosya boyutunu toplama ekle
Next
' Alt dizinleri gez
For Each subfolder In folder.SubFolders
folderCount = folderCount + 1 ' Alt dizin sayısını artır
ListFilesInFolder subfolder ' Rekürsif çağrı
Next
End Sub
' Seçilen dizindeki dosyaları listele
Dim folder
Set folder = objFSO.GetFolder(selectedPath)
ListFilesInFolder folder
' Dosya sayısını al
Dim fileCount
fileCount = UBound(Split(fileList, vbCrLf)) ' Satır sayısını al
' Toplam boyutu MB cinsine dönüştür
Dim totalSizeMB
totalSizeMB = totalSize / (1024 * 1024) ' Bayt cinsinden MB'ye dönüştür
' Kullanıcıya dosya listesini göster
WScript.Echo "Seçilen dizin: " & selectedPath & vbCrLf & "Bulunan dosya sayısı: " & fileCount & vbCrLf & "Bulunan alt dizin sayısı: " & folderCount & vbCrLf & "Toplam boyut: " & Round(totalSizeMB, 2) & " MB" & vbCrLf & vbCrLf & fileList
' Masaüstü dizinini al
Dim desktopPath
desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
' Dosya yolunu dinamik olarak oluştur
Dim outputFilePath
Dim fileIndex
fileIndex = 1
outputFilePath = desktopPath & "\dosya_listesi.txt"
' Eğer dosya zaten varsa, yeni bir isim oluştur
While objFSO.FileExists(outputFilePath)
outputFilePath = desktopPath & "\dosya_listesi_" & fileIndex & ".txt"
fileIndex = fileIndex + 1
Wend
' Dosya yazma işlemi
Set outputFile = objFSO.CreateTextFile(outputFilePath, True)
outputFile.WriteLine "Seçilen dizin: " & selectedPath
outputFile.WriteLine "Bulunan dosya sayısı: " & fileCount
outputFile.WriteLine "Bulunan alt dizin sayısı: " & folderCount
outputFile.WriteLine "Toplam boyut: " & Round(totalSizeMB, 2) & " MB"
outputFile.WriteLine vbCrLf & "Dosya Listesi:" & vbCrLf
outputFile.Write fileList
outputFile.Close
WScript.Echo "Dosya listesi masaüstüne kaydedildi: " & outputFilePath
Güle güle kullanın....
[align=center]TRWE_2012
Alaydan Yetişme PC Kullanıcısı[/align]