title: HOW To manipulate an ALREADY open word document from excel vba
body: <p>I am new to VBA and obviously I am missing something. My code works for opening a word doc and sending data to it <strong>BUT does NOT for an ALREADY OPEN</strong> word doc. I keep searching for an answer on how to send info from Excel to an OPEN Word doc/Bookmark and nothing works.</p>
  
  <p>I hope it is okay that I added all the code and the functions called. I really appreciate your help!</p>
  
  <p>What I have so far</p>
  
  <pre><code>Sub ExcelNamesToWordBookmarks()
  On Error GoTo ErrorHandler
  
  Dim wrdApp As Object 'Word.Application
  Dim wrdDoc As Object 'Word.Document
  Dim xlName As Excel.Name
  Dim ws As Worksheet
  Dim str As String 'cell/name value
  Dim cell As Range
  Dim celldata As Variant 'added to use in the test
  Dim theformat As Variant 'added
  Dim BMRange As Object
  Dim strPath As String
  Dim strFile As String
  Dim strPathFile As String
  
  Set wb = ActiveWorkbook
  strPath = wb.Path
  If strPath = "" Then
    MsgBox "Please save your Excel Spreadsheet &amp; try again."
    GoTo ErrorExit
  End If
  
  'GET FILE &amp; path of Word Doc/Dot
  strPathFile = strOpenFilePath 'call a function in MOD1
  
  If strPathFile = "" Then
    MsgBox "Please choose a Word Document (DOC*) or Template (DOT*) &amp; try again." 'strPath = Application.TemplatesPath
    GoTo ErrorExit
  End If
  
      If FileLocked(strPathFile) Then 'Err.Number = 70 if open
      'read / write file in use 'do something
      'NONE OF THESE WORK
          Set wrdApp = GetObject(strPathFile, "Word.Application")
          'Set wrdApp = Word.Documents("This is a test doc 2.docx")
      'Set wrdApp = GetObject(strPathFile).Application
      Else
      'all ok 'Create a new Word Session
              Set wrdApp = CreateObject("Word.Application")
              wrdApp.Visible = True
              wrdApp.Activate 'bring word visiable so erros do not get hidden.
      'Open document in word
              Set wrdDoc = wrdApp.Documents.Open(Filename:=strPathFile) 'Open vs wrdApp.Documents.Add(strPathFile)&lt;=&gt;create new Document1 doc
      End If
  
  'Loop through names in the activeworkbook
      For Each xlName In wb.Names
  
              If Range(xlName).Cells.Count = 1 Then
                    celldata = Range(xlName.Value)
                    'do nothing
                 Else
                    For Each cell In Range(xlName)
                       If str = "" Then
                          str = cell.Value
                       Else
                          str = str &amp; vbCrLf &amp; cell.Value
                       End If
                    Next cell
                    'MsgBox str
                    celldata = str
                 End If
  
  'Get format and strip away the spacing, negative color etc etc
  'I know this is not right... it works but not best
              theformat = Application.Range(xlName).DisplayFormat.NumberFormat
              If Len(theformat) &gt; 8 Then
                  theformat = Left(theformat, 5) 'was 8 but dont need cents
              Else
                  'do nothing for now
              End If
  
          If wrdDoc.Bookmarks.Exists(xlName.Name) Then
              'Copy the Bookmark's Range.
              Set BMRange = wrdDoc.Bookmarks(xlName.Name).Range.Duplicate
              BMRange.Text = Format(celldata, theformat)
              'Re-insert the bookmark
              wrdDoc.Bookmarks.Add xlName.Name, BMRange
          End If
  
      Next xlName
  
  
  'Activate word and display document
    With wrdApp
        .Selection.Goto What:=1, Which:=2, Name:=1  'PageNumber
        .Visible = True
        .ActiveWindow.WindowState = wdWindowStateMaximize 'WAS 0 is this needed???
        .Activate
    End With
    GoTo WeAreDone
  
  'Release the Word object to save memory and exit macro
  ErrorExit:
      MsgBox "Thank you! Bye."
      Set wrdDoc = Nothing
      Set wrdApp = Nothing
     Exit Sub
  
  'Error Handling routine
  ErrorHandler:
     If Err Then
        MsgBox "Error No: " &amp; Err.Number &amp; "; There is a problem"
        If Not wrdApp Is Nothing Then
          wrdApp.Quit False
        End If
        Resume ErrorExit
     End If
  
  WeAreDone:
  Set wrdDoc = Nothing
  Set wrdApp = Nothing
  
  End Sub
  </code></pre>
  
  <p>file picking:</p>
  
  <pre><code>Function strOpenFilePath() As String
  Dim intChoice As Integer
  Dim iFileSelect As FileDialog 'B
  
  Set iFileSelect = Application.FileDialog(msoFileDialogOpen)
  
  With iFileSelect
      .AllowMultiSelect = False 'only allow the user to select one file
      .Title = "Please... Select MS-WORD Doc*/Dot* Files"
      .Filters.Clear
      .Filters.Add "MS-WORD Doc*/Dot*  Files", "*.do*"
      .InitialView = msoFileDialogViewDetails
  End With
  
  'make the file dialog visible to the user
  intChoice = Application.FileDialog(msoFileDialogOpen).Show
  'determine what choice the user made
  If intChoice &lt;&gt; 0 Then
      'get the file path selected by the user
      strOpenFilePath = Application.FileDialog( _
      msoFileDialogOpen).SelectedItems(1)
  Else
      'nothing yet
  End If
  
  End Function
  </code></pre>
  
  <p>checking if file is open...</p>
  
  <pre><code>Function FileLocked(strFileName As String) As Boolean
     On Error Resume Next
     ' If the file is already opened by another process,
     ' and the specified type of access is not allowed,
     ' the Open operation fails and an error occurs.
     Open strFileName For Binary Access Read Write Lock Read Write As #1
     Close #1
     ' If an error occurs, the document is currently open.
     If Err.Number &lt;&gt; 0 Then
        ' Display the error number and description.
        MsgBox "Function FileLocked Error #" &amp; str(Err.Number) &amp; " - " &amp; Err.Description
        FileLocked = True
        Err.Clear
     End If
  End Function
  </code></pre>