Sub GetJournalData()
'///////////////////////////////////////////////////////////////////////////////////
'/////This function stitches together the data from the first table in all .docm////
'///////////////////////files in the listed directory.//////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////
    Dim Target As Word.Document
    Dim Source As Word.Document
    Dim RowTarget As Row
    Dim RowCount As Integer
    Dim iCounter As Integer
    Dim Folder As String
    Dim File As String
    'Set current document as Source file
    Set Source = ActiveDocument
    'Clear table of previous data, if it exists
    Do While Source.Tables(1).Rows.Count > 2
        Source.Tables(1).Rows.Last.Delete
    Loop
    'Set target folder
    Folder = "\\SharePoint@Port\teamsites\subsite\subsite\site\library\"
    'Find any and all .docm files in target folder
    File = Dir(Folder & "\*.docm")
    'Loop while there are still files to process
    Do While File <> ""
        'Open target and set Target variable
        Documents.Open FileName:=Folder & File
        Set Target = ActiveDocument
        RowCount = Target.Tables(1).Rows.Count
        For iCounter = 3 To RowCount
            'Add row and set elements
            Set RowTarget = Source.Tables(1).Rows.Add
            RowTarget.Cells(1).Range.Text = Target.Tables(1).Rows(iCounter).Cells(1).Range.Text
            RowTarget.Cells(2).Range.Text = Target.Tables(1).Rows(iCounter).Cells(2).Range.Text
            RowTarget.Cells(3).Range.Text = Target.Name
            RowTarget.Cells(4).Range.Text = Target.BuiltInDocumentProperties("Last Save Time")
        Next iCounter
        'Close target file
        Target.Close savechanges:=False
        File = Dir
    Loop
'//////////////////END//////////////////////////////////////////////////////////
End Sub

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oFSO As FileSystemObject
Dim oFolder As Folder
Dim oFile As File
  Set oFSO = New FileSystemObject
  Set oFolder = oFSO.GetFolder("Your folder path")
  For Each oFile In oFolder.Files
    Debug.Print oFile.Name
  Next oFile
  
  
End Sub

    Dim FileArray() As String
    Dim i As Long
    'Loop while there are still files to process
    Do While File <> ""
        i = i + 1
        ReDim Preserve FileArray(i)
        FileArray(i) = File
        File = Dir
    Loop
    WordBasic.SortArray FileArray
    For i = 1 To UBound(FileArray)
        Set Target = Documents.Open(FileName:=Folder & FileArray(i), AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
...
    Next

'///////////////////////////////////////////////////////////////////////////////////
'/////This function stitches together the data from the first table in all /////////
'///////////////////////files in the listed directory.//////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////
Sub GetJournalData()
    Dim Target As Word.Document
    Dim Source As Word.Document
    Dim RowTarget As Row
    Dim RowCount As Integer
    Dim iCounter As Integer
    Dim Folder As String
    Dim File As String
    Dim FileArray() As String
    Dim i As Long
    'Set current document as Source file
    Set Source = ActiveDocument
    'Clear table of previous data, if it exists
    Do While Source.Tables(1).Rows.Count > 2
        Source.Tables(1).Rows.Last.Delete
    Loop
    'Set UNC folder path
    Folder = "\\SharePointsite@Port#\teamsite\site\library\"
    File = Dir(Folder)
    'Load file array
    Do While File <> ""
        i = i + 1
        ReDim Preserve FileArray(i)
        FileArray(i) = File
        File = Dir
    Loop
    'Sort file array alphabetically with quicksort algorithm
    Call QuickSort(FileArray, LBound(FileArray), UBound(FileArray))
    'Cycle through array, opening files and grabbing data
    For i = 1 To UBound(FileArray)
        Set Target = Documents.Open(FileName:=Folder & FileArray(i), Addtorecentfiles:=False, Visible:=False, ReadOnly:=True)
        RowCount = Target.Tables(1).Rows.Count
        For iCounter = 3 To RowCount
            Set RowTarget = Source.Tables(1).Rows.Add
            RowTarget.Cells(1).Range.Text = Target.Tables(1).Rows(iCounter).Cells(1).Range.Text
            RowTarget.Cells(2).Range.Text = Target.Tables(1).Rows(iCounter).Cells(2).Range.Text
            RowTarget.Cells(3).Range.Text = Target.Name
            RowTarget.Cells(4).Range.Text = Target.BuiltInDocumentProperties("Last Save Time")
        Next iCounter
        Target.Close savechanges:=False
    Next
End Sub
'///////////////////////////////////////END/////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////
'//////This function sorts the passed array based on the start and end points///////
'///////////////////////////////////////////////////////////////////////////////////
Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
    Dim pivot   As Variant
    Dim tmpSwap As Variant
    Dim tmpLow  As Long
    Dim tmpHi   As Long
    'Set initial bounds
    tmpLow = inLow
    tmpHi = inHi
    'Calculate pivot
    pivot = vArray((inLow + inHi) \ 2)
    'Loop while lower bound is not higher than upper bound
    While (tmpLow <= tmpHi)
        'Increment lower bound loop
        While (vArray(tmpLow) < pivot And tmpLow < inHi)
            tmpLow = tmpLow + 1
        Wend
        'Decrement upper bound loop
        While (pivot < vArray(tmpHi) And tmpHi > inLow)
            tmpHi = tmpHi - 1
        Wend
        'Sort items
        If (tmpLow <= tmpHi) Then
            tmpSwap = vArray(tmpLow)
            vArray(tmpLow) = vArray(tmpHi)
            vArray(tmpHi) = tmpSwap
            tmpLow = tmpLow + 1
            tmpHi = tmpHi - 1
        End If
    Wend
    'Recursive function calls
    If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
    If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub
'///////////////////////////////////////END/////////////////////////////////////////