HOW To manipulate an ALREADY open word document from excel vba

Viewed 8276

I am new to VBA and obviously I am missing something. My code works for opening a word doc and sending data to it BUT does NOT for an ALREADY OPEN word doc. I keep searching for an answer on how to send info from Excel to an OPEN Word doc/Bookmark and nothing works.

I hope it is okay that I added all the code and the functions called. I really appreciate your help!

What I have so far

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 & try again."
  GoTo ErrorExit
End If

'GET FILE & 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*) & 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)<=>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 & vbCrLf & 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) > 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: " & Err.Number & "; 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

file picking:

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 <> 0 Then
    'get the file path selected by the user
    strOpenFilePath = Application.FileDialog( _
    msoFileDialogOpen).SelectedItems(1)
Else
    'nothing yet
End If

End Function

checking if file is open...

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 <> 0 Then
      ' Display the error number and description.
      MsgBox "Function FileLocked Error #" & str(Err.Number) & " - " & Err.Description
      FileLocked = True
      Err.Clear
   End If
End Function
3 Answers

ANSWER BELOW. Backstory... So, after input from you guys and more research I discovered that I needed to set the active word document by using the file selection the user picked and that is then passed via late binding to the sub as an object to process. NOW it works if the word file is not in word OR if it is currently loaded into word AND not even the active document. The below code replaces the code in my original question.

  1. Set Object app as word.
  2. grab the file name.
  3. Make the word doc selected active to manipulate.
  4. Set the word object to the active doc.

THANK YOU EVERYONE!

If FileLocked(strPathFile) Then 'Err.Number = 70 if open
'read / write file in use 'do something
    Set wrdApp = GetObject(, "Word.Application")
    strPathFile = Right(strPathFile, Len(strPathFile) - InStrRev(strPathFile, "\"))
    wrdApp.Documents(strPathFile).Activate ' need to set picked doc as active
    Set wrdDoc = wrdApp.ActiveDocument ' works!

This should get you the object you need.

Dim WRDFile As Word.Application
Set WRDFile = GetObject(strPathFile)

'Have Microsoft Word 16.0 Object Library selected in your references

Dim wordapp As Object
Set wordapp = GetObject(, "Word.Application")

wordapp.Documents("documentname").Select

'works if you only have one open word document. In my case, I'm trying to push updates to word links from excel.

Related