'///////////////////////////////////////////////////////////////////////////////////
'/////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/////////////////////////////////////////