Unable to create Link in the Word, using VB6
 

Hello

I have a code which works perfectly with Word 2000, but causes an error with Word 2003. The error is "Word is unable to create a link to the object you specified. Please insert the object directly into your file without creating a link." This code attempts to create links to a document within word. The code is below, with the offending code highlighted. Please can anyone help?

[code]
Private Sub cmdWord_Click()

'create Word report

Dim m_LastGroup As String
Dim m_LastType As String
Dim m_String As String
Dim m_Count As Integer

Set WordApp = CreateObject("Word.Basic")

m_Count = 0

Screen.MousePointer = c_HourGlass

On Error GoTo err_keydown
'generating a letter by merging, or replacing
'bookmarks in the letter with data from the screens


WordApp.FileOpen (App.Path & "\Letters\Public Report.doc")
WordApp.AppShow

Select Case dbcReports.Text

Case "WordPublic"
WordApp.EditGoTo , Destination:="Description"
WordApp.Insert UCase("PUBLIC")
WordApp.EditGoTo , Destination:="Type"
WordApp.Insert UCase(datPublicDoc.Recordset.Fields("Description"))
WordApp.EditGoTo , Destination:="Table"

If datPublicDoc.Recordset.RecordCount > 0 Then
datPublicDoc.Recordset.MoveFirst

Do While Not datPublicDoc.Recordset.EOF

If m_Count <= 10 Then

m_LastGroup = datPublicDoc.Recordset.Fields("RefCode")
WordApp.Insert (datPublicDoc.Recordset.Fields("Reference"))
m_String = (datPublicDoc.Recordset.Fields("DocLocation"))
m_String = Left(datPublicDoc.Recordset.Fields("DocLocation"), 1)

If m_String = "\" Then
m_Count = m_Count + 1
WordApp.InsertObject Iconnumber:=1, FileName:=g_Doc_Location & (datPublicDoc.Recordset.Fields("DocLocation")), Link:=1, displayicon:=1, Tab:="1", Class:="{00020906-0000-0000-C000-000000000046}", IconFileName:="C:\WINNT\System32\OLE2.DLL", Caption:=Chr$(34) + (datPublicDoc.Recordset.Fields("DocName"))
'WordApp.EditLinks UpdateMode:=1, Link:=m_Count
WordApp.nextcell
Else
WordApp.nextcell
End If

WordApp.Insert (datPublicDoc.Recordset.Fields("DocName"))
WordApp.nextcell

If (datPublicDoc.Recordset.Fields("Obsolete")) = True Then
WordApp.Insert "Obsolete"
WordApp.nextcell
WordApp.Insert "Obsolete"
Else
WordApp.Insert Format(datPublicDoc.Recordset.Fields("DateLastUpdated"), "dd/mm/yyyy")
WordApp.nextcell
WordApp.Insert (datPublicDoc.Recordset.Fields("DocLocation"))
End If

WordApp.nextcell
WordApp.Insert (datPublicDoc.Recordset.Fields("Name"))
WordApp.nextcell
datPublicDoc.Recordset.MoveNext

If Not datPublicDoc.Recordset.EOF Then
If m_LastGroup <> datPublicDoc.Recordset.Fields("RefCode") Then
WordApp.tabledeletecells
WordApp.tabledeletecells
WordApp.tabledeletecells
WordApp.tabledeletecells
WordApp.tabledeletecells
WordApp.linedown 2
WordApp.Insert Chr(13)
WordApp.Insert Chr$(9)
WordApp.Insert UCase(datPublicDoc.Recordset.Fields("Description"))
WordApp.Insert Chr(13)
WordApp.Insert Chr(13)
WordApp.tableinserttable numcolumns:="5", numrows:="2", initialcolwidth:="Auto", Format:="16", Apply:="167"
WordApp.tableselectcolumn
WordApp.TableColumnWidth ColumnWidth:="3.5 cm"
WordApp.nextcell
WordApp.nextcell
WordApp.tableselectcolumn
WordApp.TableColumnWidth ColumnWidth:="10 cm"
WordApp.nextcell
WordApp.nextcell
WordApp.tableselectcolumn
WordApp.TableColumnWidth ColumnWidth:="2.5 cm"
WordApp.nextcell
WordApp.nextcell
WordApp.tableselectcolumn
WordApp.TableColumnWidth ColumnWidth:="6 cm"
WordApp.nextcell
WordApp.nextcell
WordApp.tableselectcolumn
WordApp.TableColumnWidth ColumnWidth:="3 cm"
WordApp.nextcell
WordApp.tableselectrow
WordApp.Bold
WordApp.nextcell
WordApp.Insert "Reference"
WordApp.nextcell
WordApp.Insert "Document Name"
WordApp.nextcell
WordApp.Insert "Issue Date"
WordApp.nextcell
WordApp.Insert "Location"
WordApp.nextcell
WordApp.Insert "Owner"
WordApp.nextcell
End If
End If

Else
' Saves word document half way through due to limitations
' in Word
WordApp.EditBookmark Name:="start", SortBy:=0
WordApp.FileSaveAs Name:=g_Temp_Doc, Format:=0, LockAnnot:=0, Password:="", AddToMru:=1, WritePassword:="", RecommendReadOnly:=0, EmbedFonts:=0, NativePictureFormat:=0, FormsData:=0, SaveAsAOCELetter:=0
WordApp.DocClose
WordApp.FileOpen Name:=Chr$(34) + g_Temp_Doc + Chr$(34), ConfirmConversions:=0, ReadOnly:=0, AddToMru:=0, PasswordDoc:="", PasswordDot:="", Revert:=0, WritePasswordDoc:="", WritePasswordDot:=""
WordApp.EditGoTo Destination:="start"
m_Count = 0
End If
Loop

End If

WordApp.tabledeletecells
WordApp.tabledeletecells
WordApp.tabledeletecells
WordApp.tabledeletecells
WordApp.tabledeletecells


End Select

WordApp.AppShow
Screen.MousePointer = c_Pointer

Exit Sub

err_keydown:

Select Case Err.Number

Case 5022, 102 ' missing file
WordApp.Insert vbCrLf & "File not found"
Resume Next

Case Else
MsgBox Err.Description
Screen.MousePointer = c_Pointer
End Select

End Sub

[code]