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?
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
[B] 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[/B]
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