Public Arr() As String
Public Counter As Long

Sub LoopThroughFilePaths()

Dim MyArr, i As Long, x As Integer, strPath As String, sFile As String, sFileList(), oDoc As Document

strPath = "d:\temp\"
MyArr = GetSubFolders(strPath)
MyArr(0) = strPath
For x = 0 To UBound(MyArr)
    sFile = Dir$(MyArr(x) & IIf(Right(MyArr(x), 1) <> "\", "\", "") & "*.*")
    Do Until sFile = ""
            i = i + 1
            ReDim Preserve sFileList(i)
            sFileList(i) = MyArr(x) & IIf(Right(MyArr(x), 1) <> "\", "\", "") & sFile
        sFile = Dir$
    Loop
Next x
For x = 1 To UBound(sFileList)
    Set oDoc = Word.Documents.Open(sFileList(x), Visible:=False)
    Debug.Print oDoc.Name ' I will insert here what I want to do with the docs
    oDoc.Close (True)
Next x
Counter = 0

End Sub

Function GetSubFolders(RootPath As String)

Dim fso As Object, fld As Object, sf As Object, MyArr

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

End Function

Sub Demo()
Application.ScreenUpdating = False
Dim StrFolder As String, StrFileList As String
' Browse for the starting folder
StrFolder = GetTopFolder
If StrFolder = "" Then Exit Sub
StrFolder = StrFolder & "\*.doc"
If UBound(Split(CreateObject("wscript.shell").Exec("Cmd /c Dir """ & StrFolder & """ /B/S").StdOut.ReadAll, vbCrLf)) > 0 Then
  StrFileList = CreateObject("wscript.shell").Exec("Cmd /c Dir """ & StrFolder & """ /B/S").StdOut.ReadAll
End If
Application.ScreenUpdating = True
MsgBox StrFileList
End Sub

Function GetTopFolder() As String
Dim oFolder As Object
GetTopFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetTopFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function