Won't be able to really check this without the working file. However, from an initial look, why don't you try this..

Code:
Sub ConnectLocally()
    Dim conData As Object 'New ADODB.Connection
    Dim rstAssigns As Object 'New ADODB.Recordset
    Dim intCount As Integer
    Dim strSelect As String
    Dim strResults As String
    fhre = ActiveDocument.Path
    part = fhre & "\timetrack.mpp"
    
    Set conData = CreateObject("ADODB.Connection")
    Set rstAssigns = CreateObject("ADODB.RecordSet")
    conData.ConnectionString = "Provider=Microsoft.Project.OLEDB.10.0;PROJECT NAME=" & part
    conData.ConnectionTimeout = 30
    conData.Open

    strSelect = "SELECT ResourceUniqueID, AssignmentResourceID, AssignmentResourceName , TaskUniqueID, AssignmentTaskID, " & _
         " AssignmentTaskName FROM Assignments WHERE TaskUniqueID > 0 ORDER BY AssignmentTaskID ASC"
    rstAssigns.Open strSelect, conData

    Do While Not rstAssigns.EOF
        For intCount = 0 To rstAssigns.Fields.Count - 1
            strResults = strResults & "'" & _
            rstAssigns.Fields(intCount).Name & "'" & _
                Space(30 - Len(rstAssigns.Fields(intCount).Name)) & vbTab & CStr(rstAssigns.Fields(intCount).Value) & vbCrLf
        Next
        strResults = strResults & vbCrLf
        rstAssigns.MoveNext
    Loop
    
    conData.Close
    
    Open "C:\My Documents\Results.txt" For Output As #1
    Print #1, strResults
    Close #1
        
    Shell "Notepad C:\My Documents\Results.txt", vbMaximizedFocus

End Sub