بدست آوردن لیست زیر پوشه ها همراه فایل های آنها

[mc_laren]

به نام خدا
با سلام
لطفا قطعه کدی بنویسید که بتونه با دادن یک مسیر بهش
تمام فایل ها و پوشه های اون مسیر رو لیست کنه(با زیر پوشه ها و فایل ها درونشان)
با تشکر

[aliila]

تابع بازگشتی است و پیمایش درختی آن از نوع pre order است در هر گره اول نام فای ها بعد نام خود فولدر








Sub Main()
ShowFolders ("c:\aa")
End Sub




Sub ShowFolders(folderpash)
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderpash)
Dim vrt As Variant

For Each vrt In f.Files
MsgBox "file " & vrt.Name
Next

For Each vrt In f.subfolders
MsgBox "folder " & vrt.Name
ShowFolders (vrt.Path)
Next


End Sub

[aliila]

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder:", OPTIONS, strPath)

If objFolder Is Nothing Then
Wscript.Quit
End If

Set objFolderItem = objFolder.Self



Dim fso
Dim ObjOutFile
'Creating File System Object
Set fso = CreateObject("Scripting.FileSystemObject") 'Create an output file
Set ObjOutFile = fso.CreateTextFile("OutputFiles.csv") 'Writing CSV headers
ObjOutFile.WriteLine("Type,File Name,File Path") 'Call the GetFile function to get all files



GetFiles(objFolderItem.Path) 'Close the output file
ObjOutFile.Close
WScript.Echo("Completed")


Function GetFiles(FolderName)
On Error Resume Next
Dim ObjFolder
Dim ObjSubFolders
Dim ObjSubFolder
Dim ObjFiles
Dim ObjFile

Set ObjFolder = fso.GetFolder(FolderName)
Set ObjFiles = ObjFolder.Files 'Write all files to output files
For Each ObjFile In ObjFiles
ObjOutFile.WriteLine("File," & ObjFile.Name & "," & ObjFile.Path)
Next 'Getting all subfolders

Set ObjSubFolders = ObjFolder.SubFolders
For Each ObjFolder In ObjSubFolders
ObjOutFile.WriteLine("Folder," & ObjFolder.Name & "," & ObjFolder.Path)
GetFiles(ObjFolder.Path)
Next
End Function

[aliila]

'Recursively List All Files and SubFolders Inside a Folder at Any Level Depth
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder:", OPTIONS, strPath)
If objFolder Is Nothing Then
Wscript.Quit
End If
r1=inputbox("Find what : ","Replce files name")
r2=inputbox("Replace with : ","Replce files name")
Set objFolderItem = objFolder.Self
Dim fso
Dim ObjOutFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set ObjOutFile = fso.CreateTextFile("OutputFiles.csv")
ObjOutFile.WriteLine("original file,new file")
GetFiles(objFolderItem.Path)
ObjOutFile.Close
WScript.Echo("Completed")
Function GetFiles(FolderName)
On Error Resume Next
Dim ObjFolder
Dim ObjSubFolders
Dim ObjSubFolder
Dim ObjFiles
Dim ObjFile
Set ObjFolder = fso.GetFolder(FolderName)
Set ObjFiles = ObjFolder.Files



For Each ObjFile In ObjFiles


x1=ObjFile.path

if instr(x1,r1)>0 then
x2=replace(ObjFile.name, r1 , r2)


x2=ObjFolder.Path&"\"&x2


Dim Fso_mov
Set Fso_mov= WScript.CreateObject("Scripting.FileSystemObject")
Fso_mov.MoveFile x1, x2
ObjOutFile.WriteLine(x1 & "," & x2)

end if
Next



Set ObjSubFolders = ObjFolder.SubFolders
For Each ObjFolder In ObjSubFolders
'ObjOutFile.WriteLine("Folder," & ObjFolder.Name & "," & ObjFolder.Path)
GetFiles(ObjFolder.Path)
Next
End Function