Has anyone experienced "Error! Not a valid link." after linking access/excel/word

[whitespace]

Has anyone experienced "Error! Not a valid link." after linking access/excel/word

I admit that this problem is more than likely associated with Excel but it is quite advanced so hoped more people that might know the answer might look here.

Basically I have a vba macro that runs in excel and works it's way down a list of schools and updates a number of sheets using ms query (to an access database). It then produces graphs from this data, open's word and displays to a word template before unlinking and saving the file.

It works fine, except that after a random number of runs (usually around 90-100), the links in word just change to "Error! Not a valid link.". And every successive document produced just produces a document full of "Error! Not a valid link." where there should be links.

I cannot explain this - has anyone else experienced such a problem?

It really has got us stumped and would be an absolute life saver if we could get this to work so that we can just leave it running on a PC over the weekend - instead of only being able to run a few hundred at a time. Any help really is MASSIVELY appreciated - thanks for your interest.

I have attached a trimmed down version of the code here (I've just taken some of the ms query links out as there are quite a few):

Sub RunAllSchools()

Dim lMsgFilter As Long


''' Remove the message filter - this is to supress 'Excel waiting for OLE...'
CoRegisterMessageFilter 0&, lMsgFilter

Dim SchNo As String
Dim ExamID As Integer
Dim SubjID As Integer
Dim YrFlag As Integer
Dim c As Long

c = Range("B6").Value
Sheets("Run").Select

Range("A" & c).Select

' Open Word (before loop)
Dim wdApp As Word.Application
Set wdApp = New Word.Application
wdApp.DisplayAlerts = wdAlertsNone

Dim strFileName As String
Dim strPath As String

strPath = "C:\VA2005\Working\"
strFileName = Dir(strPath + "1YrSubjectTemplate.doc", vbNormal)

While Sheets("Run").Range("A" & c) <> ""
	Sheets("Run").Select
	SchNo = Sheets("Run").Range("A" & c).Value
	ExamID = Sheets("Run").Range("B" & c).Value
	SubjID = Sheets("Run").Range("C" & c).Value
	YrFlag = Sheets("Run").Range("D" & c).Value

' Move through sheets and requeary data based on new line of subject / school information in sheets("Run")
    Sheets("AllTitles").Select
    Range("A2").Select
    With Selection.QueryTable
        .Connection = Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=C:\VA2005\Working\ValueAddedProjectANALYSIS.mdb;DefaultDir=H:\Value Added\Cur" _
        ), Array( _
        "rent Year\KS4 Analysis;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _
        ))
        .CommandText = Array( _
        "SELECT qry1YrSubjectChartTitles.FLD101, qry1YrSubjectChartTitles.FLD103, qry1YrSubjectChartTitles.VA_CENTNO, qry1YrSubjectChartTitles.AUTHORITY, qry1YrSubjectChartTitles.FLD150" & Chr(13) & "" & Chr(10) & "FROM qry1YrSubjectChar" _
        , _
        "tTitles qry1YrSubjectChartTitles" & Chr(13) & "" & Chr(10) & "WHERE (qry1YrSubjectChartTitles.VA_CENTNO='" & SchNo & "')" _
        )
        .Refresh BackgroundQuery:=False
    End With
    Range("A7").Select
    With Selection.QueryTable
        .Connection = Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=C:\VA2005\Working\ValueAddedProjectANALYSIS.mdb;DefaultDir=H:\Value Added\Cur" _
        ), Array( _
        "rent Year\KS4 Analysis;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _
        ))
        .CommandText = Array( _
        "SELECT `2005_Exam_Types`.BU_Exam_ID, `2005_Exam_Types`.Description" & Chr(13) & "" & Chr(10) & "FROM `2005_Exam_Types` `2005_Exam_Types`" & Chr(13) & "" & Chr(10) & "WHERE (`2005_Exam_Types`.BU_Exam_ID=" & ExamID & ")" _
        )
        .Refresh BackgroundQuery:=False
    End With
    Range("F7").Select
    With Selection.QueryTable
        .Connection = Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=C:\VA2005\Working\ValueAddedProjectANALYSIS.mdb;DefaultDir=H:\Value Added\Cur" _
        ), Array( _
        "rent Year\KS4 Analysis;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _
        ))
        .CommandText = Array( _
        "SELECT `2005_Subjects`.BU_Subject_ID, `2005_Subjects`.`Subject Name`" & Chr(13) & "" & Chr(10) & "FROM `2005_Subjects` `2005_Subjects`" & Chr(13) & "" & Chr(10) & "WHERE (`2005_Subjects`.BU_Subject_ID=" & SubjID & ")" _
        )
        .Refresh BackgroundQuery:=False
    End With
    Range("A23").Select
    With Selection.QueryTable
        .Connection = Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=C:\VA2005\Working\ValueAddedProjectANALYSIS.mdb;DefaultDir=H:\Value Added\Cur" _
        ), Array( _
        "rent Year\KS4 Analysis;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _
        ))
        .CommandText = Array( _
        "SELECT Reg_Equations.BU_Exam_ID, Reg_Equations.BU_Subject_ID, Reg_Equations.Year, Reg_Equations.Type, Reg_Equations.count, Reg_Equations.SLopeNEWPOINTS, Reg_Equations.InterceptNewPoints, Reg_Equations" _
        , _
        ".rNewPoints, Reg_Equations.SENewPoints, Reg_Equations.SLopeOLDPOINTS, Reg_Equations.InterceptOldPoints, Reg_Equations.rOldPoints, Reg_Equations.SEOldPoints" & Chr(13) & "" & Chr(10) & "FROM Reg_Equations Reg_Equations" & Chr(13) & "" & Chr(10) & "WHERE (Re" _
        , _
        "g_Equations.BU_Exam_ID=" & ExamID & ") AND (Reg_Equations.BU_Subject_ID=" & SubjID & ") AND (Reg_Equations.Year=1)" & Chr(13) & "" & Chr(10) & "ORDER BY Reg_Equations.Type" _
        )
        .Refresh BackgroundQuery:=False
    End With
    Sheets("AllPupilData").Select
    Range("A1").Select
    With Selection.QueryTable
        .Connection = Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=C:\VA2005\Working\ValueAddedProjectANALYSIS.mdb;DefaultDir=H:\Value Added\Cur" _
        ), Array( _
        "rent Year\KS4 Analysis;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;UID=admin;" _
        ))
        .CommandText = Array( _
        "SELECT PupilResults.VA_CENTNO, PupilResults.BU_Exam_ID, PupilResults.BU_Subject_ID, PupilResults.Gender, PupilResults.Band, PupilResults.MeanSAS, PupilResults.MeanGCSENew, PupilResults.MeanGCSEOld, Pu" _
        , _
        "pilResults.YearFlag" & Chr(13) & "" & Chr(10) & "FROM PupilResults PupilResults" & Chr(13) & "" & Chr(10) & "WHERE (PupilResults.BU_Exam_ID=" & ExamID & ") AND (PupilResults.BU_Subject_ID=" & SubjID & ") AND (PupilResults.YearFlag=" & YrFlag & ")" & Chr(13) & "" & Chr(10) & "ORDER BY PupilResults.VA_CENTNO" _
        )
        .Refresh BackgroundQuery:=False
    End With

' PLEASE NOTE: there are many more sheets selected and queries updated in the actual macro - maybe this is the prob???
    
    ' Now Open Word template and save as filename
    wdApp.Visible = True
    wdApp.Documents.Open Filename:=strPath + strFileName
        
    ' Need to wait or excel will go out of sync - I APPRECIATE THAT THIS ISN'T THE IDEAL WAY OF DOING THINGS!!
    Application.Wait (Now + TimeValue("0:00:05"))
    Dim dr As String 
    
    wdApp.ActiveDocument.Fields.Update
    
    wdApp.ActiveDocument.Fields.Unlink
     
    dr = Sheets("Run").Range("E" & c).Value
     
    ' create folder if it doesn't exist
    If Len(Dir(dr, vbDirectory)) = 0 Then
        MkDir dr
    End If
    
    'Save as specified filename (from worksheet)
    wdApp.ActiveDocument.SaveAs Filename:=Sheets("Run").Range("E" & c).Value & Sheets("Run").Range("F" & c).Value
    'wdApp.SaveAs Filename:=Range("F" & c).Value
    wdApp.ActiveDocument.Close SaveChanges:=False
    wdApp.Visible = False
    
   ' Update sheet so we know what time the subject was run 
   Sheets("Run").Range("G" & c).Value = Now()    
    
    c = c + 1    
    
Wend
    
wdApp.DisplayAlerts = wdAlertsAll
wdApp.Quit
Set wdApp = Nothing

''' Restore the message filter
CoRegisterMessageFilter lMsgFilter, lMsgFilter

End Sub