Set word variable to a document that’s already open

Hi there,

Thanks for looking.

I'm using the following variables as part of my larger procedure...

Dim wrdApp As Word.Application
Dim wrdMyDoc As Word.Document

...and setting them as follows:

Set wrdApp = New Word.Application
Set wrdMyDoc = wrdApp.Documents.Open(Range("C1") & Application.PathSeparator & Range("C2"))

I just want to know how I'd set the wrdMyDoc variable if the desired document is already opened as I don't want to re-open it again in an another instance of Word as is the current case.

Note that as the code uses early binding a reference to 'Microsoft Word nn.n Object Library' is required. Also cell C1 contains the directory while cell C2 contains the file name.

Any advice would be greatly appreciated.

Kind regards,

Robert

Try something like this see if it helps:

Sub testopenword()
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim blnOpen As Boolean
    
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err.Number = 429 Then
        Set wdApp = New Word.Application
    Else
        blnOpen = True 'Word application was initially opened
    End If
    Set wdDoc = wdApp.Documents(Range("C2")) 'See if document was already opened
    
    'Error 4160: Bad file name -> Document not opened, open it
    If Err.Number = 4160 Then
        'MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description
        Set wdDoc = wdApp.Documents.Open(Range("C1") & Application.PathSeparator & Range("C2"))
    End If
    On Error GoTo 0
    
    ' ...
    ' ...
    ' ... Your code
    ' ...
    ' ...
    
    wdDoc.Close
    Set wdDoc = Nothing
    
    If Not blnOpen Then 'Word application was opened by this macro, close it
        wdApp.Quit
    End If
    Set wdApp = Nothing
    
End Sub

Hi millz,

Thanks for that. Unfortunately it always produces the 'Bad file name' error at this line...

Set wdDoc = wdApp.Documents(Range("C2"))

...even though the file is definitely open and visible. I do vaguely recall this being a known issue and that the only way around it was to use the document's index number which I'm not sure how to get, would you?

The only other way I can think of is to try and return each name in the Taskbar to check if the file is open but this seems like overkill to me.

Appreciate any further help.

Robert

No, still no go. Did you get it to work on a local machine or from a server (as I'm trying)?

This is what I just tried again. If word is not opened, macro launches it, and open the document Doc1.docx. If Doc1 is already opened, no error occurs.

Edit: I work between Access and Excel a lot, so part of the code is what I actually use to launch Excel from Access, only amended to try to make it work for you. I don't know how differently would it work between a local machine and a server.

Sub testopenword()
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim blnOpen As Boolean
    
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err.Number = 429 Then
        Set wdApp = New Word.Application
        wdApp.Visible = True
    Else
        blnOpen = True 'Word application was initially opened
    End If
    Set wdDoc = wdApp.Documents("Doc1") 'See if document was already opened
    
    'Error 4160: Bad file name -> Document not opened, open it
    If Err.Number = 4160 Then
        'Set wdDoc = wdApp.Documents.Open(Range("C1") & Application.PathSeparator & Range("C2"))
        Set wdDoc = wdApp.Documents.Open("C:\Desktop\Doc1.docx")
    End If
    On Error GoTo 0
    
    ' ...
    ' ...
    ' ... Your code
    ' ...
    ' ...
    
    'wdDoc.Close 'Removed for testing purposes
    Set wdDoc = Nothing
    
    If Not blnOpen Then 'Word application was opened by this macro, close it
        'wdApp.Quit 'Removed for testing purposes
    End If
    Set wdApp = Nothing
    
End Sub

No, whatever I try it keeps returning the Bad File Name error message. I'll keep digging.

I really appreciate your efforts

Regards,

Robert

Perhaps you can try with GetObject("path of file")

No as that opens the same document in a separate instance of Word - just what I'm trying to avoid.

I've almost solved it with this, I found the work around was to use an object if Word is already open as so (the code is quite long as it copies a named range from Excel into a bookmark of the same name in Word and has error checking built in):

Option Explicit
Sub CopyNamedRangeToWordBookmark()

    'As this code uses early binding, a reference to 'Microsoft Word nn.n Object Library' is required
    
    'http://www.excelforum.com/excel-programming-vba-macros/970323-set-word-variable-to-a-document-that-s-already-open.html#post3485081

    Dim wrdApp As Word.Application
    Dim wrdMyDoc As Word.Document
    Dim rngNamedRangeCheck As Range
    Dim objWordApp As Object
    Dim blnNewInstance As Boolean
    
    'Check if Word is already open (thanks to millz for this)
    On Error Resume Next
        Set wrdApp = GetObject(, "Word.Application")
        If Err.Number = 429 Then
            Set wrdApp = New Word.Application
            blnNewInstance = True
        Else
            Set objWordApp = GetObject(, "Word.Application") 'Word is already open. No need for a another, separate instance
        End If
    On Error GoTo 0
    
    If blnNewInstance = True Then
        Set wrdMyDoc = wrdApp.Documents.Open(Range("B1") & Application.PathSeparator & Range("B2"))
    Else
        Set wrdMyDoc = objWordApp.Documents.Open(Range("B1") & Application.PathSeparator & Range("B2"))
    End If
    
    'Verify the bookmark exists by trying to go to it
    On Error Resume Next
        If blnNewInstance = True Then
            wrdApp.Selection.Goto What:=wdGoToBookmark, Name:=CStr(Range("B3"))
        Else
            objWordApp.Selection.Goto What:=wdGoToBookmark, Name:=CStr(Range("B3"))
        End If
        If Err.Number <> 0 Then
            MsgBox "As there is no bookmark called """ & Range("B3") & """ in the """ & Range("B2") & """ document the process has been terminated." & vbNewLine & "Check the document name and / or create the bookmark and try again.", vbCritical, "Populate Word Bookmarks Editor"
            Set wrdApp = Nothing
            Set wrdMyDoc = Nothing
            Exit Sub
        End If
    On Error GoTo 0
    
    'Verify the Excel named range exists
    On Error Resume Next
        Set rngNamedRangeCheck = Range(CStr(Range("B3")))
    On Error GoTo 0
    If rngNamedRangeCheck Is Nothing Then
        MsgBox "As there is no named range called """ & Range("B3") & """ in this workbook the process has been terminated." & vbNewLine & "Create the named range and try again.", vbCritical, "Populate Word Bookmarks Editor"
        Set wrdApp = Nothing
        Set wrdMyDoc = Nothing
        Exit Sub
    End If
    
    'If we get here all is OK to copy the Excel named range to the Word bookmark
    With Application
        .ScreenUpdating = False
        .StatusBar = "Please wait while the bookmark is populated..."
    End With
    
    If blnNewInstance = True Then
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:=CStr(Range("B3"))
    Else
        objWordApp.Selection.Goto What:=wdGoToBookmark, Name:=CStr(Range("B3"))
    End If
    Range(CStr(Range("B3"))).Copy
    
    If blnNewInstance = True Then
        'For a full list and brief description of the WdRecoveryType constants see fumei's post # 5 here http://www.vbaexpress.com/forum/archive/index.php/t-22299.html
        'wrdApp.Selection.PasteSpecial wdTableOriginalFormatting
        'wrdApp.Selection.PasteAndFormat wdFormatOriginalFormatting
        'wrdApp.Selection.PasteSpecial wdFormatOriginalFormatting
        'wrdApp.Selection.Paste
        'wrdApp.Selection.PasteExcelTable False, True, False
        wrdApp.Selection.PasteSpecial (xlPasteFormats)
    Else
        'objWordApp.Selection.PasteSpecial wdTableOriginalFormatting
        'objWordApp.Selection.PasteSpecial wdFormatOriginalFormatting
        'objWordApp.Selection.Paste
        'objWordApp.Selection.PasteExcelTable False, True, False
        'objWordApp.Selection.PasteAndFormat (WdPasteOptions.wdKeepSourceFormatting)
        'objWordApp.Documents.Add.Content.Paste
        'objWordApp.Selection.PasteSpecial (WdPasteOptions.wdKeepSourceFormatting)
        objWordApp.Selection.PasteSpecial (xlPasteFormats)
    End If
    
    Application.CutCopyMode = False
            
    'Insert a date stamp into cell A8.
    Range("A8").Value = Evaluate("T(""Last run date: "" &TEXT(NOW(), ""mmm-dd-yyyy"") & "" "" & LOWER(TEXT(NOW(), ""h:mmAM/PM"")))")
    
    If blnNewInstance = True Then
        wrdApp.Visible = True
    Else
        objWordApp.Visible = True
    End If
    wrdMyDoc.ActiveWindow.Visible = True
    
    Set wrdApp = Nothing
    Set wrdMyDoc = Nothing
    Set rngNamedRangeCheck = Nothing
    Set objWordApp = Nothing
    
    MsgBox "The named range """ & Range("B3") & """ has now been copied to the same bookmark in the """ & Range("B2") & """ word document.", vbInformation, "Populate Word Bookmarks Editor"
        
    With Application
        .StatusBar = ""
        .ScreenUpdating = True
    End With
    
End Sub

The only remaining issue is the cell fill color from Excel isn't be transferred to the Word bookmark. Not sure why.

Thank you both, especially millz

Robert

Hi Izandol,

Yes, that does seem like the case. I think it had opened the same document from another test I was doing (I've been on this for days!!).

Great work Izandol and thanks for posting

Robert