| | |
Unable to create Link in the Word, using VB6
![]() |
•
•
Join Date: Sep 2008
Posts: 3
Reputation:
Solved Threads: 0
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]
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]
![]() |
Other Threads in the Visual Basic 4 / 5 / 6 Forum
- Previous Thread: how to run a sub over again from a button click...
- Next Thread: VB 6.0 + POWERPOINT automation
| Thread Tools | Search this Thread |
* 6 429 2007 access activex add age application basic beginner birth bmp calculator cd cells.find click client code college component connection connectionproblemusingvb6usingoledb copy creat ctrl+f data database datareport date delete dissertations dissertationthesis dissertationtopic edit error excel excelmacro file filename form hardware header iamthwee image inboxinvb internetfiledownload keypress label listbox listview liveperson login looping machine microsoft movingranges number objectinsert open oracle password prime program prompt range-objects readfile reading record refresh remotesqlserverdatabase report save search sendbyte sites sort sql sql2008 sqlserver subroutine tags textbox time urldownloadtofile vb vb6 vb6.0 vba visual visualbasic visualbasic6 web window windows





