VBA - Shared Workbook and Embedded Objects

[richh]

Hi all,

I have a shared workbook that contains an embedded Word object in one of the tabs. My code uses data collected from other workbooks to fill in elements on the Word document, prints them, then updates the record as having been completed. The code has been running perfectly until a few weeks ago but now whenever the document is set to Shared, we keep getting Error 1004: Verb method of OLEObject class failed. I can't really step through the code in Shared mode, but I would imagine the code is breaking at "objOLE.Verb xlOpen".

Any tips on how to avoid this in the future would be swell.

    Dim defaultP    As String
    Dim objWord     As Object, objNewDoc As Object ''Word.Document
    Dim objOLE      As OLEObject
    Dim ws          As Worksheet
    Dim wsLog       As Worksheet
    Dim sh          As Shape
    Dim recrow      As Long
    Dim lRow        As Integer
    
    defaultP = Application.ActivePrinter
    
    Set ws = Application.ThisWorkbook.Worksheets("Generator")
    
    Set wsLog = Application.ThisWorkbook.Worksheets("Log")
    
    lRow = wsLog.Cells(Rows.Count, 1).End(xlUp).Row
    
    Set sh = ws.Shapes("Doc")
    
    Set objOLE = sh.OLEFormat.Object

    'Instead of activating in-place, open in Word
    objOLE.Verb xlOpen
    
    Set objWord = objOLE.Object 'The Word document
    
    With Me
        If .millPrinter1 = True Then
            objWord.Application.ActivePrinter = "\\PRINTER1" 'on Ne05:"
        ElseIf .millPrinter2 = True Then
            objWord.Application.ActivePrinter = "\\PRINTER2"  'on Ne06:"
        ElseIf .millPrinter3 = True Then
            objWord.Application.ActivePrinter = "\\PRINTER3" ' on Ne09:"
        ElseIf .millPrinter4 = True Then
            objWord.Application.ActivePrinter = defaultP
        End If
        
        For i = 0 To .millStudentList.ListCount - 1
            recrow = .millStudentList.List(i, 4)
            objWord.SelectContentControlsByTitle("Name").Item(1).Range.Text = wsLog.Cells(recrow, 3) & " " & wsLog.Cells(recrow, 4)
            objWord.SelectContentControlsByTitle("Date").Item(1).Range.Text = wsLog.Cells(recrow, 10) & " Day of " & wsLog.Cells(recrow, 9) & ", Two Thousand " & wsLog.Cells(recrow, 11)
            objWord.PrintOut Copies:=1, ManualDuplexPrint:=False
        
            wsLog.Cells(recrow, 12) = Format(Date, "mm/dd/yyyy")
        Next i
    End With
    
    Call PopulateListBox(wsLog, lRow, 3)
    Call PopulateListBox(wsLog, lRow, 4)
    
    Application.ActivePrinter = defaultP
    
    'objWord.Close
    
    Set ws = Nothing
    Set wsLog = Nothing
    Set objWord = Nothing
    Set objOLE = Nothing
    Set sh = Nothing
    
End Sub