GetObject(<FileFullName>) 287 Error

Question

I have VBA code in an Excel file which uses Application.GetOpenFilename to browse to and open a required Word Document (.docx).

Once the file is open another procedure in the same module, is called, that procedure starts:

Sub PopulateWord()

    Dim x, y, i As Long, sKap As String, sFieldText As String

    Set oDoc = GetObject(sfile)

The variable sfile is Dimmed for all procedures in the module.

Set oDoc = GetObject(sfile) works fine on my machine but is giving a 287 error on another machine (the Word Document opens OK on that machine).

I can see no reason why GetObject should fail on one machine but not fail on another, any help or suggestions greatly appreciated.

Answer 1

Here  is the complete code

Option Explicit

Dim oDoc As Object, sfile As String

Dim sText As String, sStyle As String, b As Boolean

Sub GenerateMergefields()

    Dim x, y(), i As Long, ii As Long, sPath As String

    sPath = ThisWorkbook.Path & Application.PathSeparator & _

            "Reports" & Application.PathSeparator

    GetWordFile

    If b = 0 Then Exit Sub

    x = [tblDefinitions]

    For i = 1 To UBound(x, 1)

        If x(i, 3) <> "" Then

            ii = ii + 1: ReDim Preserve y(1 To 20, 1 To ii)

            y(4, ii) = i: y(5, ii) = 0: y(6, ii) = x(i, 3): y(7, ii) = 3

            y(15, ii) = x(i, 1): y(19, ii) = x(i, 2): y(20, ii) = x(i, 4)

        End If

    Next

    Application.ScreenUpdating = 0

    With Mergefields.ListObjects(1)

        If .Parent.[d2] <> "" Then .DataBodyRange.Delete

        .Resize .Parent.[a1].Resize(ii + 1, 20)

        .DataBodyRange = Application.Transpose(y)

        .Parent.Activate

    End With

    PopulateWord

    Set oDoc = GetObject(sfile)

    oDoc.SaveAs sPath & Format(Date, "yyyyddmm") & "_Mergefields_Report"

    ThisWorkbook.Activate

    Application.DisplayAlerts = 0

    Kapitel.Delete

    ThisWorkbook.SaveAs sPath & Format(Date, "yyyyddmm") & "_Mergefields.xlsx", 51

    ActiveWorkbook.Save

    Application.DisplayAlerts = 1

    MsgBox "Word Report successfully created.", 64, "Word Report."

    Set oDoc = Nothing

End Sub

Sub GetWordFile()

    Dim oWd As Object, f As Boolean

    ChDir ThisWorkbook.Path

    sfile = Application.GetOpenFilename( _

        FileFilter:="Word Files *.doc* (*.doc*),", _

        Title:="Browse to and open required word file.", _

        MultiSelect:=False)

        b = 0

    If sfile <> "False" Then

        On Error Resume Next

        Set oDoc = GetObject(sfile)

        On Error GoTo 0

        If oDoc Is Nothing Then

            Set oWd = GetObject(, "Word.Application")

            If oWd Is Nothing Then

                Set oWd = CreateObject("Word.Application")

                If oWd Is Nothing Then

                    MsgBox "Failed to start Word!", 16, "Word File Selection"

                    Exit Sub

                End If

                f = 1

            End If

            Set oDoc = oWd.Documents.Open(sfile)

            If oDoc Is Nothing Then

                MsgBox "Failed to open selected document!", 16, "Word File Selection"

                If f Then

                    oWd.Quit

                End If

                Exit Sub

            End If

            oWd.Visible = True

        Else

            With oDoc.Parent

                .Visible = True

            End With

            b = 1

        End If

    Else

        Application.DisplayAlerts = 0

        MsgBox "No file selected.", 16, "Word File Selection"

        Application.DisplayAlerts = 1

    End If

    Set oWd = Nothing: Set oDoc = Nothing

End Sub

Sub PopulateWord()

    Dim x, y, i As Long, sKap As String, sFldText As String

    Set oDoc = GetObject(sfile)

    x = [tblMergefields]

    With oDoc

        .Activate

        With .Parent.Selection

            i = i + 1

            GetTextAndStyle CStr(x(i, 20))

            .TypeText Text:=x(i, 20) & " " & sText

            .Style = oDoc.Styles(sStyle)

            .TypeParagraph

            sFldText = "MERGEFIELD  " & x(i, 6) & " "

            .Fields.Add .Range, -1, sFldText, 1

            .Style = oDoc.Styles("Normal")

            .TypeParagraph

            .TypeParagraph

            i = i + 1

            GetTextAndStyle CStr(x(i, 20))

            .TypeText Text:=x(i, 20) & " " & sText

            .Style = oDoc.Styles(sStyle)

            .TypeParagraph

            sFldText = "MERGEFIELD  " & x(i, 6) & " "

            .Fields.Add .Range, -1, sFldText, 1

            .Style = oDoc.Styles("Normal")

            .TypeParagraph

            .TypeParagraph

            i = i + 1

            GetTextAndStyle CStr(x(i, 20))

            .TypeText Text:=x(i, 20) & " " & sText

            .Style = oDoc.Styles(sStyle)

            .TypeParagraph

            sKap = x(i, 20)

            Do

                sFldText = "MERGEFIELD  " & x(i, 6) & " "

                .Fields.Add .Range, -1, sFldText, 1

                .Style = oDoc.Styles("Normal")

                .TypeParagraph

                i = i + 1

                If i = UBound(x, 1) + 1 Then

                    .TypeBackspace

                    GoTo Done

                End If

            Loop Until x(i, 20) <> sKap

            .TypeParagraph

            GetTextAndStyle CStr(x(i, 20))

            .TypeText Text:=x(i, 20) & " " & sText

            .Style = oDoc.Styles(sStyle)

            .TypeParagraph

            sKap = x(i, 20)

            Do

                sFldText = "MERGEFIELD  " & x(i, 6) & " "

                .Fields.Add .Range, -1, sFldText, 1

                .Style = oDoc.Styles("Normal")

                .TypeParagraph

                i = i + 1

                If i = UBound(x, 1) + 1 Then

                    .TypeBackspace

                    GoTo Done

                End If

            Loop Until x(i, 20) <> sKap

            .TypeParagraph

            GetTextAndStyle CStr(x(i, 20))

            .TypeText Text:=x(i, 20) & " " & sText

            .Style = oDoc.Styles(sStyle)

            .TypeParagraph

            sKap = x(i, 20)

            Do

                sFldText = "MERGEFIELD  " & x(i, 6) & " "

                .Fields.Add .Range, -1, sFldText, 1

                .Style = oDoc.Styles("Normal")

                .TypeParagraph

                i = i + 1

                If i = UBound(x, 1) + 1 Then

                    .TypeBackspace

                    GoTo Done

                End If

            Loop Until x(i, 20) <> sKap

            .TypeParagraph

            GetTextAndStyle CStr(x(i, 20))

            .TypeText Text:=x(i, 20) & " " & sText

            .Style = oDoc.Styles(sStyle)

            .TypeParagraph

            sKap = x(i, 20)

            Do

                sFldText = "MERGEFIELD  " & x(i, 6) & " "

                .Fields.Add .Range, -1, sFldText, 1

                .Style = oDoc.Styles("Normal")

                .TypeParagraph

                i = i + 1

                If i = UBound(x, 1) + 1 Then

                    .TypeBackspace

                    GoTo Done

                End If

            Loop Until x(i, 20) <> sKap

            .TypeParagraph

            GetTextAndStyle CStr(x(i, 20))

            .TypeText Text:=x(i, 20) & " " & sText

            .Style = oDoc.Styles(sStyle)

            .TypeParagraph

            sKap = x(i, 20)

            Do

                sFldText = "MERGEFIELD  " & x(i, 6) & " "

                .Fields.Add .Range, -1, sFldText, 1

                .Style = oDoc.Styles("Normal")

                .TypeParagraph

                i = i + 1

                If i = UBound(x, 1) + 1 Then

                    .TypeBackspace

                    GoTo Done

                End If

            Loop Until x(i, 20) <> sKap

            .TypeParagraph

        End With

    End With

Done:

    Set oDoc = Nothing

End Sub

Sub GetTextAndStyle(s As String)

    Dim x, i As Integer

    x = [tblKapitel]

    For i = 1 To UBound(x, 1)

        If x(i, 1) = s Then

            sText = x(i, 2)

            If x(i, 4) = "Normal" Then

                sStyle = "Normal"

            Else

                sStyle = UCase(x(i, 4))

            End If

            Exit For

        End If

    Next

    If i = UBound(x, 1) + 1 Then

        sText = x(i, 2)

        sStyle = "Normal"

    End If

End Sub

Answer 2

It will be easier to help if you provide all of the code from both procedures