excel - 如何从excel vba操作已打开的Word文档

我是VBA的新手，显然我缺少一些东西。我的代码适用于打开Word文档并向其发送数据，但不适用于“已经打开”的Word文档。我一直在寻找有关如何将信息从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

最佳答案

这应该为您提供所需的对象。

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

关于excel - 如何从excel vba操作已打开的Word文档，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/47333972/