Question

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

我希望我添加所有代码和调用的函数是可以的。我真的很感谢你的帮助！

到目前为止我有什么

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

这可以为您提供所需的对象。

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

Answer 2

下面回答。 Backstory ... 所以，经过你们的投入和更多研究后我发现我需要通过使用文件选择来设置活动的word文档用户选择然后通过后期绑定传递给作为要处理的对象的子。现在如果单词文件不在单词OR中它是否有效，如果它当前加载到单词而不是活动文档中。以下代码替换了原始问题中的代码。

将对象应用设为单词。
抓住文件名。
激活单词doc以进行操作。
将单词对象设置为活动文档。

谢谢大家！

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 3

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

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

wordapp.Documents("documentname").Select

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

如何操作excel vba中的ALREADY打开word文档

3 个答案:

谢谢大家！