Option Explicit
Dim listArgs
Dim objFileSystem
Dim objFolder, objSubFolder,
objFile, objCvsFile
Dim strFolder
Dim strCsvFile
Set listArgs = WScript.Arguments
Set objFileSystem = CreateObject
("Scripting.FileSystemObject")
If listArgs.Count = 0 Then
strFolder = InputBox("Aranacak klasörlerin adı?","Klasör seçimi", "C:\")
Else
strFolder = listArgs(0)
End If
strCsvFile = "C:\Temp\ListeDOC.csv"
strCsvFile = InputBox("Oluşturulacak liste için isim ve konum?","CVS-dosyasını adlandırma", strCsvFile)
If Right(strCsvFile,4) <> ".csv" Then
strCsvFile = strCsvFile & ".csv"
End If
Set objCvsFile = objFileSystem.
CreateTextFile(strCsvFile1,true)
objCvsFile.Write "Dosyanın adı" & ";" &
"Dosya konumu" & vbNewLine
listFiles strFolder
objCvsFile.Close
MsgBox "Dosya " & strCsvFile & "
oluşturulacak!"
WScript.Quit
Function listFiles(strFolder)
If objFileSystem.FolderExists(strFolder)
Then
Set objFolder = objFileSystem.
GetFolder(strFolder)
For Each objFile In objFolder.Files
If UCase(Right(objFile.Name,4)) = ".DOC"
Or UCase(Right(objFile.Name,5)) =
".DOCX" Then
objCvsFile.Write objFile.Name & ";" &
objFolder.Path & vbNewLine
End If
Next
For Each objSubFolder In
objFolder.SubFolders
listFiles objSubFolder.path
Next
Else
MsgBox "Verilen klasör" & strFolder &
"bulunamıyor!"
End If
End Function