Start Loop Rows From - Row 10 on wards - Listing Files

[dj44]

Hi Folks,

:)

Im trying to get the file names and file paths listed from row

10 in Columns J and K

I've tried to add a few bits in but this simple task is becoming very confusing - and breaking my code.

I am very bad at using resize cells







Public Arr() As String
Public Counter As Long

Sub ListFiles()

'Taken from stack

'http://stackoverflow.com/questions/22392177/find-file-and-insert-path-into-cell
Dim myArr
Dim i As Long
Dim j As Long
Dim MyFile As String


Const strPath As String = "C:\Users\DJ\Desktop\Files\" ' change it as per your needs
myArr = GetSubFolders(strPath)
Application.ScreenUpdating = False
For j = LBound(Arr) To UBound(Arr)
MyFile = Dir(myArr(j) & "\*.txt")



Do While Len(MyFile) <> 0

' How do i get it to start from Row 10?

i = i + 1
Cells(i, 10) = MyFile
Cells(i, 11) = myArr(j)


MyFile = Dir
Loop
Next j

Application.ScreenUpdating = True
End Sub

Function GetSubFolders(RootPath As String)
Dim fso As Object
Dim fld As Object
Dim sf As Object
Dim myArr

Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(RootPath)
For Each sf In fld.SubFolders
Counter = Counter + 1
ReDim Preserve Arr(Counter)
Arr(Counter) = sf.Path
myArr = GetSubFolders(sf.Path)
Next
GetSubFolders = Arr
Set sf = Nothing
Set fld = Nothing
Set fso = Nothing

End Function



Thank you for your help

[SamT]

Do While Len(MyFile) <> 0

' How do i get it to start from Row 10?

i = i + 1
Cells(i, 10) = MyFile
Cells(i, 11)




' How do i get it to start from Row 10?
i = 9
Do While Len(MyFile) <> 0

i = i + 1
Cells(i, 10) = MyFile
Cells(i, 11)

[dj44]

Hello Sam,

doh :doh:,

right so this worked although i swear i fiddled about to no end.

But now i noticed another infuriating quirk

The text files from the main parent Folder won't get picked up.

im assuming its to do with the orginal code.

is there a one liner i can add to include the Main folder FILES?

always sumthing:)

[YasserKhalil]

Try this


Public Arr() As String
Public Counter As Long


Sub ListFiles()
Dim myArr As Variant
Dim i As Long
Dim j As Long
Dim myFile As String


'Change Path To Suit
Const strPath As String = "C:\Users\Future\Desktop\Files\"


'If You Need To Start At 10 Type 9
i = 9


Application.ScreenUpdating = False
myArr = GetSubFolders(strPath)




myFile = Dir(strPath & "\*.txt")
If myFile <> "" Then
Do While Len(myFile) <> 0
i = i + 1
Cells(i, 10) = myFile
Cells(i, 11) = strPath
myFile = Dir
Loop
End If


For j = LBound(Arr) + 1 To UBound(Arr)
myFile = Dir(myArr(j) & "\*.txt")


Do While Len(myFile) <> 0
i = i + 1
Cells(i, 10) = myFile
Cells(i, 11) = myArr(j)


myFile = Dir
Loop
Next j


Erase myArr: Erase Arr: Counter = 0
Application.ScreenUpdating = True
End Sub


Function GetSubFolders(RootPath As String)
Dim fso As Object
Dim fld As Object
Dim sf As Object
Dim myArr As Variant


Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(RootPath)


For Each sf In fld.SubFolders
Counter = Counter + 1
ReDim Preserve Arr(Counter)
Arr(Counter) = sf.Path
myArr = GetSubFolders(sf.Path)
Next sf


GetSubFolders = Arr


Set sf = Nothing
Set fld = Nothing
Set fso = Nothing
End Function

[dj44]

Hello Yasser,

Thank you for going to the trouble to write and add to this code.

I wish I had the skills to take on this vba

For some reason it only picks up the first text file in the parent

Why oh why it must be Friday the 13th at play


The subfolder files it picks up ok

[SamT]

You need to set both "MyFile= Dir(etc)" sections of code in Dir Loops.


And don't sweat it. Your course so far is typical for newbies. :D

[YasserKhalil]

Hello
I have edited post #4. Have a look at it

[dj44]

Thank you Yasser & Sam,

good gentlemen of the vba arts.

I can only say that a mountain goat probably has better coding skills them me.:grinhalo:

I cant fathom the verbosity of vba and have to guess after the umpteenth time, and i did spend a few hours before i posted trying to tame this

oh well onto the next task to clean up my modules now

alls well now

Have a great weekend all

thanks again

:friends:

[YasserKhalil]

You're welcome. Glad we can help you
Regards