CODEWITHSUNDEEP
excelvbams-word
Morris
Morris

Reputation: 161

Copy data from an Excel-File to an open Word-File

I hope I did not oversee a similar question.

I use the code down below to copy data from one excel-file to a specific word-file. This works without any big problems.

The only thing I like to improve is the fact, that the word-file has to be closed.

Is there a way to past data to an open word-file using this method?

Public Function Export()
Dim appWord As Object
Dim wdDoc As Object
.
.
.
Set appWord = CreateObject("Word.Application") 
Set wdDoc = appWord.Documents.Open(wrdfile)
With wdDoc
.Bookmarks("Mark1").Range.Text = ActiveSheet.Range("X24").Value
.Bookmarks("Mark2").Range.Text = ActiveSheet.Range("H23").Value
.
.
.
End with
End function

Is tried Documents.Add(...) but that just opens a new instance of the word file.

Thanks for your help Morris

Upvotes: 0

Views: 381

Answers (1)

macropod
macropod

Reputation: 13505

For example:

Sub Demo()
Application.ScreenUpdating = True
Dim wdApp As Object, wdDoc As Object, StrDocNm As String
Dim bStrt As Boolean, bFound As Boolean
'Check whether the document exists
StrDocNm = "C:\Users\" & Environ("Username") & "\Documents\Document Name.doc"
If Dir(StrDocNm) = "" Then
  MsgBox "Cannot find the designated document: " & StrDocNm, vbExclamation
  Exit Sub
End If
' Test whether Word is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Word, so we can close it later.
Set wdApp = GetObject(, "Word.Application")
'Start Word if it isn't running
If wdApp Is Nothing Then
  Set wdApp = CreateObject("Word.Application")
  If wdApp Is Nothing Then
    MsgBox "Can't start Word.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Word, so we can terminate it later.
  bStrt = True
End If
On Error GoTo 0
'Check if the document is open.
bFound = False
With wdApp
  .Visible = True
  For Each wdDoc In .Documents
    If wdDoc.FullName = StrDocNm Then ' We already have it open
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrDocNm) = True Then
      ' Report and exit if true
      MsgBox "The Word document is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set wdDoc = .Documents.Open(FileName:=StrDocNm)
    If wdDoc Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrDocNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  With wdDoc
    'Only now can we can process the document!!!
    .Save
    'Close the document if we opened it
    If bFound = False Then .Close
  End With
  If bStrt = True Then .Quit
End With
End Sub

Function IsFileLocked(strFileName As String) As Boolean
  On Error Resume Next
  Open strFileName For Binary Access Read Write Lock Read Write As #1
  Close #1
  IsFileLocked = Err.Number
  Err.Clear
End Function

Upvotes: 2

Related Questions