Pulling file names & path from folder and putting them in cells
 

Is there a way for VBA to pull file names & path for all files(including
subfolders) from a specific folder?

Steven

Pulling file names & path from folder and putting them in cells
 

see http://msdn2.microsoft.com/en-us/lib...ffice.10).aspx


Sub TestGetFiles()
' Call to test GetFiles function.

Dim dctDict As Dictionary
Dim varItem As Variant

' Create new dictionary.
Set dctDict = New Dictionary
' Call recursively, return files into Dictionary object.
If GetFiles("p:\chat", dctDict, True) Then
' Print items in dictionary.
For Each varItem In dctDict
Debug.Print varItem
Next
End If
End Sub
Function GetFiles(strPath As String, _
dctDict As Dictionary, _
Optional blnRecursive As Boolean) As Boolean

' This procedure returns all the files in a directory into
' a Dictionary object. If called recursively, it also returns
' all files in subfolders.

Dim fsoSysObj As FileSystemObject
Dim fdrFolder As Folder
Dim fdrSubFolder As Folder
Dim filFile As File

' Return new FileSystemObject.
Set fsoSysObj = New FileSystemObject

On Error Resume Next
' Get folder.
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err < 0 Then
' Incorrect path.
GetFiles = False
GoTo GetFiles_End
End If
On Error GoTo 0

' Loop through Files collection, adding to dictionary.
For Each filFile In fdrFolder.Files
dctDict.Add filFile.Path, filFile.Path
Next filFile

' If Recursive flag is true, call recursively.
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, dctDict, True
Next fdrSubFolder
End If

' Return True if no error occurred.
GetFiles = True

GetFiles_End:
Exit Function
End Function



"Ren" wrote:

Is there a way for VBA to pull file names & path for all files(including
subfolders) from a specific folder?

Steven

Pulling file names & path from folder and putting them in cells
 

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean

arfiles = Array()
cnt = -1
level = 1

sFolder = "E:\"
ReDim arfiles(2, 0)
If sFolder < "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If

If sPath = "" Then
sPath = CurDir
End If

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)



"Ren" wrote in message
...
Is there a way for VBA to pull file names & path for all files(including
subfolders) from a specific folder?

Steven

Pulling file names & path from folder and putting them in cell
 

Do you know why i am getting a "Compile error: User=defined type not defined"
error" Is there a library i should load?

"DomThePom" wrote:

see http://msdn2.microsoft.com/en-us/lib...ffice.10).aspx


Sub TestGetFiles()
' Call to test GetFiles function.

Dim dctDict As Dictionary
Dim varItem As Variant

' Create new dictionary.
Set dctDict = New Dictionary
' Call recursively, return files into Dictionary object.
If GetFiles("p:\chat", dctDict, True) Then
' Print items in dictionary.
For Each varItem In dctDict
Debug.Print varItem
Next
End If
End Sub
Function GetFiles(strPath As String, _
dctDict As Dictionary, _
Optional blnRecursive As Boolean) As Boolean

' This procedure returns all the files in a directory into
' a Dictionary object. If called recursively, it also returns
' all files in subfolders.

Dim fsoSysObj As FileSystemObject
Dim fdrFolder As Folder
Dim fdrSubFolder As Folder
Dim filFile As File

' Return new FileSystemObject.
Set fsoSysObj = New FileSystemObject

On Error Resume Next
' Get folder.
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err < 0 Then
' Incorrect path.
GetFiles = False
GoTo GetFiles_End
End If
On Error GoTo 0

' Loop through Files collection, adding to dictionary.
For Each filFile In fdrFolder.Files
dctDict.Add filFile.Path, filFile.Path
Next filFile

' If Recursive flag is true, call recursively.
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, dctDict, True
Next fdrSubFolder
End If

' Return True if no error occurred.
GetFiles = True

GetFiles_End:
Exit Function
End Function



"Ren" wrote:

Is there a way for VBA to pull file names & path for all files(including
subfolders) from a specific folder?

Steven

Pulling file names & path from folder and putting them in cell
 

Thanks Bob. I got this to work for my purpose. Quck question though. What
does the Split(sPath,"\") command do?

"Bob Phillips" wrote:

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean

arfiles = Array()
cnt = -1
level = 1

sFolder = "E:\"
ReDim arfiles(2, 0)
If sFolder < "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If

If sPath = "" Then
sPath = CurDir
End If

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)



"Ren" wrote in message
...
Is there a way for VBA to pull file names & path for all files(including
subfolders) from a specific folder?

Steven

Pulling file names & path from folder and putting them in cell
 

Figured it out. Thanks.

"Ren" wrote:

Thanks Bob. I got this to work for my purpose. Quck question though. What
does the Split(sPath,"\") command do?

"Bob Phillips" wrote:

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean

arfiles = Array()
cnt = -1
level = 1

sFolder = "E:\"
ReDim arfiles(2, 0)
If sFolder < "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If

If sPath = "" Then
sPath = CurDir
End If

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)



"Ren" wrote in message
...
Is there a way for VBA to pull file names & path for all files(including
subfolders) from a specific folder?

Steven