Template with macro encounter 2147417848 error

[liezlm]

I have MS Word 2007 template with macro. It selects a file, attach the file and creates a hyperlink pointing to the file. Breaks down on this part:

ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _
Address:=sLnkAddress, SubAddress:="", ScreenTip:="", _
TextToDisplay:=sLnkDisplay

The error is Run-time error '-2147417848(80010108)':
Automation error
The object invoked has disconnected from its clients.

Do you have any suggestion how to resolve this? I searched other threads but nothing is similar to this problem.

Private Sub cmdOK_Click()
 Dim sDesc As String
 Dim sOriginalPath As String
 Dim sLnkAddress As String
 Dim sLnkDisplay As String
 Dim sFile As String
 Dim i As Integer
 Dim n As Integer
 Dim sBase As String
     
On Error GoTo Error_Catch
sBase = GetDataDirectory() & "\" & sMeetingType & "\Attachment\" & _
ActiveDocument.Variables("sLevel1Text").Value & "\" & _
                ActiveDocument.Variables("sLevel2Text").Value
    
' are there any attachments?
If Me.lstAttach.ListCount > 0 Then
' common variables for every attachment
sFile = CheckFilenames()
        
If sFile <> "OK" Then
MsgBox "The following file already exists in the attachment folder - " & _
vbCrLf & "please rename the attachment, or check the existing file" & _
                    vbCrLf & vbCrLf & sFile, vbExclamation, "MySystem"
Exit Sub
End If
        
' find existing attachments and clear
Selection.HomeKey Unit:=wdStory
If FindString("", "caps_AttachBook") = True Then
Selection.Delete Unit:=wdCharacter, Count:=1
End If
        
' find spot to put attachments
Selection.HomeKey Unit:=wdStory
If FindString("", "caps_Author") = True Then
Selection.Collapse wdCollapseStart
        
Selection.TypeText Text:="Attachments:" & vbTab
Selection.TypeParagraph
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Style = "caps_AttachBook"
            
intAttach = 0
            
'loop thru attachments
For i = 0 To Me.lstAttach.ListCount - 1
If Left(Me.lstAttach.List(i, 0), 10) <> "NOT FOUND:" Then
' create cover?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If Me.lstAttach.List(i, 2) = "True" Then
' single cover for all attachments needs to list all
' document descriptions and total number of pages
If Me.lstAttach.List(i, 4) = "True" Then
For n = 0 To Me.lstAttach.ListCount - 1
If n <> i Then
If Me.lstAttach.List(n, 2) <> "True" Then
sDesc = sDesc & Me.lstAttach.List(n, 0) & Chr(11)
End If
End If
Next n
Else
sDesc = Me.lstAttach.List(i, 0)
End If
                            
sPages = Me.lstAttach.List(i, 3)
                        
' create new file?
If Me.lstAttach.List(i, 1) = "" Then
CreateFile sDesc, Me.lstAttach.List(i, 0), True, _
Me.lstAttach.List(i, 4) = "True"
Else
' check that master cover page is up-to-date
If Me.lstAttach.List(i, 4) = "True" Then
CheckProperty Me.lstAttach.List(i, 1), "DescriptiveText", sDesc
End If
                            
' update attachment number
CheckProperty Me.lstAttach.List(i, 1), "AttachNo", intAttach + 1
' ~~~~~~~~~~~~~~~~~~
End If
                    
sLnkAddress = sAttachPath & Me.lstAttach.List(i, 0) & ".docx"
sLnkDisplay = Me.lstAttach.List(i, 0)
End If
                    
' create header?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If Me.lstAttach.List(i, 1) = "" And Me.lstAttach.List(i, 2) = "False" Then
sPages = Me.lstAttach.List(i, 3)
CreateFile Me.lstAttach.List(i, 0), Me.lstAttach.List(i, 0), _
False, False
                        
sLnkAddress = sAttachPath & Me.lstAttach.List(i, 0) & ".docx"
sLnkDisplay = Me.lstAttach.List(i, 0)
                    
'update attachment number
Else
If Me.lstAttach.List(i, 1) <> "" And Me.lstAttach.List(i, 2) = "False" Then
'file extension
If LCase(Right(Me.lstAttach.List(i, 1), 5)) = ".docx" Then
CheckProperty Me.lstAttach.List(i, 1), "AttachNo", intAttach + 1
End If
End If
' ~~~~~~~~~~~~~~~~~~
End If
                    
' create file?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If Me.lstAttach.List(i, 1) <> "" Then
' don't copy the file if it already exists in attachments folder
sOriginalPath = Left(Me.lstAttach.List(i, 1), _
InStrRev(Me.lstAttach.List(i, 1), "\"))
sExtension = Mid(Me.lstAttach.List(i, 1), _
InStrRev(Me.lstAttach.List(i, 1), "."))
                                        
If sOriginalPath <> sAttachPath Then
If LCase(Right(Me.lstAttach.List(i, 0), Len(sExtension))) _
<> LCase(sExtension) Then
                                
FileCopy Me.lstAttach.List(i, 1), _
sAttachPath & Me.lstAttach.List(i, 0) & sExtension
sLnkAddress = sAttachPath & Me.lstAttach.List(i, 0) & sExtension
                            
Else
FileCopy Me.lstAttach.List(i, 1), _
sAttachPath & Me.lstAttach.List(i, 0)
sLnkAddress = sAttachPath & Me.lstAttach.List(i, 0)
End If
                        
Else
sLnkAddress = Me.lstAttach.List(i, 1)
End If
                    
sLnkDisplay = Me.lstAttach.List(i, 0)
End If
    
' create the link
On Error Resume Next
'replace spaces in address
'sLnkAddress = Replace(sLnkAddress, sBase, "")
'sLnkAddress = Replace(sLnkAddress, " ", "%20")
                    
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _
Address:=sLnkAddress, SubAddress:="", ScreenTip:="", _
TextToDisplay:=sLnkDisplay
                            
'link shows full path when created, so have to
' reapply the text to be displayed
Selection.MoveLeft wdCharacter, 1
Selection.Hyperlinks(1).TextToDisplay = sLnkDisplay
Selection.MoveDown wdParagraph, 1
Selection.MoveLeft wdCharacter, 1
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Selection.TypeText Chr(11)
                    
' create a property for the attachment
intAttach = intAttach + 1
                                      Utilities.ChangeCustomDocProperty "Attach_" & intAttach, _
sLnkAddress, True
End If
                
sDesc = ""
Next i
End If
End If
    
' remove the last line break
Selection.TypeBackspace
    
Unload Me

Exit Sub

 

[fumei]

This is a wide post, so I can not see everything, but this looks funny to me:

sBase = GetDataDirectory() & "\" ' ....and more

sBase is a string, and GetDataDirectory() looks like a Sub. Maybe it is a function, but if it is, i am wondering about the brackets. In any case, it certainly looks like a procedure, and perhaps it is there that you are having a problem?

Further you use a variable sAttachPath:

sLnkAddress = sAttachPath & Me.lstAttach.List(i, 0) & ".docx"

but that variable is neither declared, and given a value, nor does it appear to passed into the procedure.

From its name, it possibly sounds like a connection sort of thing. Maybe?

"A little piece of heaven
without that awkward dying part."

advertisment for Reese's Peanut Butter Cups (a chocolate/peanut butter confection)

Gerry