VBA-Copy data from Excel to Word

G

george hart

Board Regular
Joined
Dec 4, 2008
Messages
241
The code below was working fine in that it activated my word doc "HSS Fleet Report 0500" - just suddenly stopped working, no error msg though.

It also should copy data from my excel file and paste into the "HSS Fleet Report 0500" word doc but doesn't.

Any ideas would be most appreciated as I'm loosing the will...

Dim WordApp As Object
Dim wrdDoc As Object
Dim tmpDoc As Object
Dim WDoc As String
Dim myDoc As String
myDoc = "HSS Fleet Report 0500"
WDoc = ThisWorkbook.Path & "\" & myDoc & ".doc"
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If WordApp Is Nothing Then
' no current word application
Set WordApp = CreateObject("Word.application")
Set wrdDoc = WordApp.Documents.Open(WDoc)
WordApp.Visible = True
Else
' word app running
For Each tmpDoc In WordApp.Documents
If StrComp(tmpDoc.FullName, WDoc, vbTextCompare) = 0 Then
' this is your doc
Set wrdDoc = tmpDoc
Exit For
End If
Next
If wrdDoc Is Nothing Then
' not open
Set wrdDoc = WordApp.Documents.Open(WDoc)

'Excel copy etc
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

WordApp.Activate

ActiveWorkbook:
Selection.PasteSpecial Link:=False, DataType:=20, Placement:=wdInLine, _
DisplayAsIcon:=False
End If
End If
End Sub

HELP please...
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Sort by date Sort by votes
Comment out the On Error Resume Next and then run it to see where it fails. You will need to comment out the other lines too. Or, just use Debug by pressing F8 in the code.
 
Last edited:
Upvote 0
There are some things that your macro should consider. For one, check that the file exists. After this line:
Code: 
WDoc = ThisWorkbook.Path & "\" & myDoc & ".doc"
Add:
Code: 
MsgBox Dir(WDoc = ThisWorkbook.Path & "\" & myDoc & ".doc")
If nothing is shown, then the file does not exist.
 
Upvote 0
All sorted now.

As I know the word doc will be open I just used this: The only problem I now have is that it doesn't copy the data over from the excel file.?? Any ideas.

Dim WordApp As Object
Dim wrdDoc As Object
Dim tmpDoc As Object
Dim WDoc As String
Dim myDoc As String
myDoc = "HSS Fleet Report 0500"
WDoc = ThisWorkbook.Path & "\" & myDoc & ".doc"
'On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
WordApp.Activate
'Excel copy etc
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy


'WordApp.Activate

ActiveWorkbook:
Selection.PasteSpecial Link:=False, DataType:=20, Placement:=wdInLine, _
DisplayAsIcon:=False
 
Upvote 0
Both Excel and MSWord have a Selection object. So, prefix Selection with Excel like Excel.Selection to be literal and for sure do it for your WordApp object when using Selection. WordApp.Selection

Since you may be using a late binding method with CreateObject or GetObject, constants in the MSWord application like wdInLine will not work. I normally get the constant values from MSWord's VBE since I record a macro there anyway to start that sort of project. To find the value in Excel, I would recommend doing an early binding to MSWord and type in VBE's Immediate Window:
Code: 
MsgBox wdInLine
What I like to do with constants like that is to define them in the code. That way, they still make sense when using late binding methods.

Here is an example showing the Selection object in MSWord. The constants used, works because I had set the Microsoft Word 14.0 Object Library in VBE's Tools > References. There is nothing wrong with using both late and early binding methods. You get the best of both worlds.
Code: 
Option Explicit
'http://www.vbaexpress.com/forum/showthread.php?t=33463
Sub ExportCellsToWordBookMarks()
    Dim wdApp As Word.Application
    Dim myDoc As Word.Document
    Dim mywdRange As Word.Range
    Dim bm As Word.Bookmark, bmName As String, s As String
    Dim r As Excel.Range
    Dim doc As String
    
    doc = "x:\msword\ExportCellsToWordBookMarks.docx"
    If Dir(doc) = "" Then
      MsgBox "Error, file does not exist." & vbLf & doc, vbCritical, "File is Missing"
      Exit Sub
    End If
     
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo errorHandler
     
      Set myDoc = wdApp.Documents.Add(Template:=doc)
      wdApp.Visible = True
       
    For Each bm In myDoc.Bookmarks
      bmName = bm.Name
      If Left(bmName, 5) = "excel" Then
        Set r = Excel.Range(Right(bmName, Len(bmName) - 5))
        If r.Value = "" Then
          bm.Select
          wdApp.Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
          s = wdApp.Selection.Text
          While Left(s, 1) = " "
            wdApp.Selection.TypeBackspace
            'wdApp.Selection.Delete Unit:=wdCharacter, Count:=1
            'wdApp.Selection.Select
            wdApp.Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            s = wdApp.Selection.Text
          Wend
          wdApp.Selection.MoveRight
          bm.Delete
          Else
            bm.Range.Text = r.Value
        End If
      End If
    Next bm
    
    Set wdApp = Nothing
    Set myDoc = Nothing
    Set mywdRange = Nothing
    Exit Sub
 
Last edited:
Upvote 0
Got it. This works a treat. Just found it o the web!!!!


Dim WordApp As Object
Dim wrdDoc As Object
Dim tmpDoc As Object
Dim WDoc As String
Dim myDoc As String

myDoc = "HSS Fleet Report 0500"
WDoc = ThisWorkbook.Path & "\" & myDoc & ".doc"

Set WordApp = GetObject(, "Word.Application")
'Excel copy etc
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
WordApp.Activate
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
Placement:=wdInLine, DisplayAsIcon:=False
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
Help please! Can't figure out how to automatically generate reports and include task description in the generated Excel word doc
Replies
1
Views
231
ttp921
T
T
  • Question
AUTOMATIC POP-UP FOR DEADLINES IN WORD DOC
Replies
0
Views
174
ttp921
T
F
  • Question
VBA create bulk Word docs from Excel
Replies
2
Views
420
Fluff
Fluff
B
  • Question
export to word issue
Replies
1
Views
393
BrendanDixon
B
F
  • Question
VBA run code based off cell value
Replies
1
Views
306
igold
igold

Forum statistics

Threads
1,214,541
Messages
6,120,110
Members
448,945
Latest member
Vmanchoppy

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top