Excel VBA GetFolder from 2 Drive (2 location)

[harky]

I had a code which work very well for 1 location (path)


Possible to open and run 2 location?

Sub GetFolder()


Range("A:L").ClearContents
Range("A1").Value = "Name"
Range("B1").Value = "ParentFolder"
Range("A1").Select




Dim strPath As String
strPath = "K:\VIEWING"


[COLOR=#ff0000]'strPath(0) = "C:\VIEWING\"[/COLOR]
[COLOR=#ff0000]'strPath(1) = "D:\ABC\"[/COLOR]






Dim OBJ As Object, Folder As Object, File As Object


Set OBJ = CreateObject("Scripting.FileSystemObject")
Set Folder = OBJ.GetFolder(strPath)


Call ListFiles(Folder)


Dim SubFolder As Object


For Each SubFolder In Folder.SubFolders
    Call ListFiles(SubFolder)
    Call GetSubFolders(SubFolder)
Next SubFolder


Range("A1").Select


End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sub ListFiles(ByRef Folder As Object)


For Each File In Folder.Files
        ActiveCell.Offset(1, 0).Select
        ActiveCell = Folder.Name
        ActiveCell.Offset(0, 1) = File.ParentFolder
Next File


End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sub GetSubFolders(ByRef SubFolder As Object)


Dim FolderItem As Object


For Each FolderItem In SubFolder.SubFolders
    Call ListFiles(FolderItem)
    Call GetSubFolders(FolderItem)
Next FolderItem


End Sub

 

[DanteAmor]

You can run the folders you want in a cycle.

Sub GetFolder()
  Dim OBJ As Object, Folder As Object, File As Object
  Dim SubFolder As Object, aFolders() As Variant, i As Long
  Range("A:L").ClearContents
  Range("A1").Value = "Name"
  Range("B1").Value = "ParentFolder"
  Range("A1").Select
  aFolders = Array([COLOR=#0000ff]"C:\VIEWING\"[/COLOR], [COLOR=#ff0000]"D:\ABC\"[/COLOR])
  Set OBJ = CreateObject("Scripting.FileSystemObject")
  For i = 0 To UBound(aFolders)
    Set Folder = OBJ.GetFolder(aFolders(i))
    Call ListFiles(Folder)
    For Each SubFolder In Folder.SubFolders
      Call ListFiles(SubFolder)
      Call GetSubFolders(SubFolder)
    Next SubFolder
  Next
  Range("A1").Select
End Sub
'
Sub ListFiles(ByRef Folder As Object)
  Dim File As Object
  For Each File In Folder.Files
    ActiveCell.Offset(1, 0).Select
    ActiveCell = Folder.Name
    ActiveCell.Offset(0, 1) = File.ParentFolder
    ActiveCell.Offset(0, 2) = File.Name
  Next File
End Sub
'
Sub GetSubFolders(ByRef SubFolder As Object)
  Dim FolderItem As Object
  For Each FolderItem In SubFolder.SubFolders
    Call ListFiles(FolderItem)
    Call GetSubFolders(FolderItem)
  Next FolderItem
End Sub

 

[harky]

Thanks it works!

You can run the folders you want in a cycle.

Sub GetFolder()
  Dim OBJ As Object, Folder As Object, File As Object
  Dim SubFolder As Object, aFolders() As Variant, i As Long
  Range("A:L").ClearContents
  Range("A1").Value = "Name"
  Range("B1").Value = "ParentFolder"
  Range("A1").Select
  aFolders = Array([COLOR=#0000ff]"C:\VIEWING\"[/COLOR], [COLOR=#ff0000]"D:\ABC\"[/COLOR])
  Set OBJ = CreateObject("Scripting.FileSystemObject")
  For i = 0 To UBound(aFolders)
    Set Folder = OBJ.GetFolder(aFolders(i))
    Call ListFiles(Folder)
    For Each SubFolder In Folder.SubFolders
      Call ListFiles(SubFolder)
      Call GetSubFolders(SubFolder)
    Next SubFolder
  Next
  Range("A1").Select
End Sub
'
Sub ListFiles(ByRef Folder As Object)
  Dim File As Object
  For Each File In Folder.Files
    ActiveCell.Offset(1, 0).Select
    ActiveCell = Folder.Name
    ActiveCell.Offset(0, 1) = File.ParentFolder
    ActiveCell.Offset(0, 2) = File.Name
  Next File
End Sub
'
Sub GetSubFolders(ByRef SubFolder As Object)
  Dim FolderItem As Object
  For Each FolderItem In SubFolder.SubFolders
    Call ListFiles(FolderItem)
    Call GetSubFolders(FolderItem)
  Next FolderItem
End Sub

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.