Copy numbers from Excel to Word with VBA

[Scott]

I have to write a report every month using data from an Excel file. Is there
a way to automate this process by feeding the word document with Excel data
by using VBA codes? I am thinking of creating bookmarks on a Word template
and copy numbers from certain cells of Excel spreadsheet to these bookmarks.
Any sample codes to accomplish this? Or any better idea? Thanks.

 

[aidan.heritage]

You could do it with Edit Paste Special in word, and pasting a link,
but personally I would do it with VBA - see example below (taken from a
real example!)

Dim appwd As Object
On Error GoTo notloaded
Set appwd = GetObject(, "Word.Application")
notloaded:
If Err.Number = 429 Then
Set appwd = CreateObject("Word.Application")
End If
appwd.Visible = True
appwd.FileOpen holdvar$
' On Error GoTo 0
With appwd

holdvar = "FileLocationAndName" 'eg c:\docs\mytemplate.dot"
.documents.Add Template:=holdvar
On Error GoTo 0
With .activedocument
.bookmarks("polno").Range = Range("b3").Value
end with

 

[Scott]

The program stops at "appwd.FileOpen holdvar$". It says, "Run-time error
'438': Object doesn't support this property or method". Any clue?

 

[Ed]

Hi, Scott. I think I would approach this using your idea: creating a
"master dummy" document with bookmarks, then a macro that would open the
Excel file and read the specific cells to populate the bookmarks. At the
end of the macro, a SaveAs statement would save the changed doc as a new
one, preserving the "master" for the next use.

The following ins untested, but I think it's close.

HTH
Ed

Sub GetExcelInfo()

Dim objDoc As Document
Dim objBkm As Bookmark
Dim objXL As Excel.Application
Dim objWB As Excel.Workbook
Dim strPath As String
Dim strBkm As String

Set objDoc = ActiveDocument

strPath = Application.GetOpenFilename("Microsoft Excel Files (*.xls),
*.xls")

Set objXL = New Excel.Application
objXL.Visible = True
Set objWB = objXL.Workbooks.Open(strPath)

For Each objBkm In objDoc.Bookmarks
strBkm = objBkm.Name

Select Case strBkm
Case "ThisOne"
objBkm.Range.Text = objWB.Sheets("Sheet1").Range("A1")
' Repeat for other bookmarks
End Select

Next objBkm

objDoc.SaveAs FileName:="Report" & Format(Now, "mmddyy") & ".doc"

objWB.Close SaveChanges:=False
objXL.Quit

Set objWB = Nothing
Set objXL = Nothing

End Sub

 

[Ed]

The first one's got a bug in getting the Excel file. I tested this one, and
it works to populate Word bookmarks from an Excel file.

Ed

Sub GetExcelInfo()

Dim objDoc As Document
Dim objBkm As Bookmark
Dim objXL As Excel.Application
Dim objWB As Excel.Workbook
Dim strPath As String
Dim strBkm As String

Set objDoc = ActiveDocument

Set objXL = New Excel.Application
objXL.Visible = True
strPath = objXL.GetOpenFilename("Microsoft Excel Files (*.xls), *.xls")
Set objWB = objXL.Workbooks.Open(strPath)

For Each objBkm In objDoc.Bookmarks
strBkm = objBkm.Name

Select Case strBkm
Case "ThisOne"
objBkm.Range.Text = objWB.Sheets("Sheet1").Range("A1")
Case "ThatOne"
objBkm.Range.Text = objWB.Sheets("Sheet1").Range("A2")
Case "TheOtherOne"
objBkm.Range.Text = objWB.Sheets("Sheet1").Range("A3")
' Repeat for other bookmarks
End Select

Next objBkm

objDoc.SaveAs FileName:="Report" & Format(Now, "mmddyy") & ".doc"

objWB.Close SaveChanges:=False
objXL.Quit

Set objWB = Nothing
Set objXL = Nothing

 

[Scott]

Thank you both very much, aidan and Ed.
Now the following codes work well:

Dim NewDoc As document
Dim NewObj As Object
Dim MyFile As String

On Error GoTo notloaded
Set NewObj = GetObject(, "Word.Application")

MyFile = "C:\Projects 2006\MyTemplate.doc"

notloaded:
If Err.Number = 429 Then
Set NewObj = CreateObject("Word.Application")
End If

NewObj.Visible = True

NewObj.Documents.Open (MyFile)

On Error GoTo 0

With NewObj
.Documents.Add Template:=MyFile
On Error GoTo 0
With .ActiveDocument
.bookmarks("StName").Range = Sheets("Input").Range("B8").Value
.bookmarks("MyDate").Range = Format(Now, "mm/" & Chr(160) &
"dd/" & Chr(160) & "yyyy")
.bookmarks("TargetROE").Range =
Sheets("Input").Range("D79").Value * 100 & "%"
End With
End With

Set NewDoc = ActiveDocument
NewDoc.SaveAs FileName:=Sheets("Input").Range("S7").Value & " -
Proposal" & Format(Now, "mmyy") & ".doc"

Documents(MyFile).Close SaveChanges:=False
Set NewObj = Nothing

 

[aidan.heritage]

The only thing that I would change would be to save MyTemplate.doc as a
TEMPLATE (DOT) and then create a new document based on this - a minor
thing, but it ensures that you don't accidentally save data on the
document!