如何從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 鏈接。