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

[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