如何从excel vba操作一个已经打开的word文档

Question

我是 VBA 的新手，显然我错过了一些东西。 我的代码适用于打开 word 文档并向其发送数据，但不适用于 ALREADY OPEN word doc。 我一直在寻找有关如何将信息从 Excel 发送到 OPEN Word 文档/书签的答案，但没有任何效果。

我希望我添加了所有代码和调用的函数没问题。 我真的很感谢你的帮助！

到目前为止我所拥有的

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

文件选取：

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

检查文件是否打开...

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

Answer 1

回答如下。 背景故事......所以，在你们的输入和更多的研究之后，我发现我需要使用用户选择的文件选择来设置活动的 word 文档，然后通过后期绑定传递到 sub 作为要处理的对象。 现在，如果 word 文件不在 word 中，或者当前已加载到 word 中并且甚至不是活动文档，则它可以工作。 下面的代码替换了我原来问题中的代码。

1. 将对象应用程序设置为单词。
2. 获取文件名。
3. 使选定的单词 doc 处于活动状态以进行操作。
4. 将 word 对象设置为活动文档。

谢谢大家！

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!

Answer 2

这应该会让你得到你需要的对象。

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

Answer 3

'在参考文献中选择 Microsoft Word 16.0 对象库

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

wordapp.Documents("documentname").Select

'如果您只有一个打开的 Word 文档，则有效。 就我而言，我正在尝试从 excel 推送更新到 word 链接。