Path & File Name

[mrsviqt]

I have the code below that gives me the file names within a certain path. I
now want a macro that will give me the subfolders and files within a drive
(for example, instead of Q:\PDF\mis90 it will say M:\Amyand will list the
folder names, and the files within those folders). Is this even possible?
Thanks in advance for any assistance you may provide.



Option Explicit

Public Sub Tester()

Dim WB As Workbook
Dim SH As Worksheet
Dim destRng As Range
Dim oFSO As Object
Dim oFolder As Object
Dim ofile As Object
Dim sFolderName As String
Dim i As Long

Const sPath As String = _
"Q:\PDF\mis_90"

Set WB = Workbooks("MyBook.xls")
Set SH = WB.Sheets("Sheet1")
Set destRng = SH.Range("B1")

Set oFSO = CreateObject("Scripting.FileSystemObject")
sFolderName = sPath & Application.PathSeparator

On Error Resume Next
Set oFolder = oFSO.GetFolder(sFolderName)
On Error GoTo XIT
If Not oFolder Is Nothing Then
For Each ofile In oFolder.Files
destRng.Offset(i).Value = ofile.Name
i = i + 1
Next ofile
End If

XIT:
Set ofile = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
End Sub

 

[Jennifer]

I have the code below that gives me the file names within a certain path. I
now want a macro that will give me the subfolders and files within a drive
(for example, instead of Q:\PDF\mis90 it will say M:\Amyand will list the
folder names, and the files within those folders).  Is this even possible?
Thanks in advance for any assistance you may provide.

Option Explicit

Public Sub Tester()

    Dim WB As Workbook
    Dim SH As Worksheet
    Dim destRng As Range
    Dim oFSO As Object
    Dim oFolder As Object
    Dim ofile As Object
    Dim sFolderName As String
    Dim i As Long

    Const sPath As String = _
           "Q:\PDF\mis_90"

    Set WB = Workbooks("MyBook.xls")
    Set SH = WB.Sheets("Sheet1")
    Set destRng = SH.Range("B1")

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    sFolderName = sPath & Application.PathSeparator

    On Error Resume Next
    Set oFolder = oFSO.GetFolder(sFolderName)
    On Error GoTo XIT
    If Not oFolder Is Nothing Then
        For Each ofile In oFolder.Files
            destRng.Offset(i).Value = ofile.Name
            i = i + 1
        Next ofile
    End If

XIT:
    Set ofile = Nothing
    Set oFolder = Nothing
    Set oFSO = Nothing
End Sub

This is an example of what you said you want. If you want the
subfolders of the subfolders, then you need something else.

Dim fso
Set fso = CreateObject("scripting.filesystemobject")

Dim fil
Dim fol
Dim SubFol

Set fol = fso.GetFolder("C:\")

For Each SubFol In fol.SubFolders
WScript.Echo " "
WScript.Echo SubFol.Path
WScript.Echo "--------------------"
For Each fil In SubFol.Files
WScript.Echo fil.Path
Next
Next

 

[mrsviqt]

It doesn't work. It says "variable not defined".

 

[yngve]

This is an example of what you said you want. If you want the
subfolders of the subfolders, then you need something else.

Dim fso
Set fso = CreateObject("scripting.filesystemobject")

Dim fil
Dim fol
Dim SubFol

Set fol = fso.GetFolder("C:\")

For Each SubFol In fol.SubFolders
        WScript.Echo " "
        WScript.Echo SubFol.Path
        WScript.Echo "--------------------"
        For Each fil In SubFol.Files
                WScript.Echo fil.Path
        Next
Next– Skjul sitert tekst –

– Vis sitert tekst –

Hi

You can try this, fond it on the nett.


Sub GetFileName()
Dim strFolder As String
Dim ffTemp As Object, vntTemp
Dim buf(), i As Long
strFolder = GetFolder
If strFolder = vbNullString Then Exit Sub
With Application.FileSearch
.NewSearch
.LookIn = strFolder
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True 'As you like
If .Execute > 0 Then
Set ffTemp = .FoundFiles
Else
MsgBox "There is no files"
Exit Sub
End If
End With
Columns(1).Clear
For Each vntTemp In ffTemp
i = i + 1
ReDim Preserve buf(1 To i)
buf(i) = Dir(vntTemp)
Next
[A1].Resize(UBound(buf)).Value = Application.Transpose(buf)
End Sub


Function GetFolder() As String
Dim objFF As Object
Dim driv As String


Set objFF = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please select folder", 0, "c:\\")
If Not objFF Is Nothing Then
GetFolder = objFF.items.Item.Path
Else
GetFolder = vbNullString
End If
Set objFF = Nothing
End Function

regards Yngve