Neler yeni
MEGAForum - Teknoloji Forumu

Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı yada giriş yapmalısınız. Forum üye olmak tamamen ücretsizdir.

Dosya/Dizin Listeleme/Kaydetme VBS Betiği

TRWE_2012

لِيَغْفِرَ لَكَ اللّٰهُ مَا تَقَدَّمَ مِنْ ذَنْبِك
Moderatör
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]
cEgaJcm.jpeg


iKtxTBJ.jpeg


6UBR8mM.jpeg


8wgK2eZ.jpeg
[/align]

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]
 
Üst Alt