View Single Post
 
Old 06-08-2019, 01:18 PM
eduzs eduzs is offline Windows 10 Office 2010 32bit
Expert
 
Join Date: May 2017
Posts: 260
eduzs is on a distinguished road
Default

I think this is impossible without at least one sub and one function:
I've solved the problem with a solution based in a post elsewhere and some adaptations:
Any improvement suggestions? (it will be perfect if it's only a SUB without public or functions)
Thanks
Code:
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

Last edited by eduzs; 06-09-2019 at 06:19 AM.
Reply With Quote