Excel VBA GetFolder from 2 Drive (2 location)

harky

Active Member
Joined
Apr 8, 2010
Messages
316
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I had a code which work very well for 1 location (path)


Possible to open and run 2 location?


Code:
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
 

Some videos you may like

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
You can run the folders you want in a cycle.

Code:
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

Active Member
Joined
Apr 8, 2010
Messages
316
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Thanks it works!


You can run the folders you want in a cycle.

Code:
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

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,504
Messages
5,602,060
Members
414,498
Latest member
jordanmiller7890

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top