lsivak
02-05-2016, 12:59 PM
Please someone help!!! Why doesn't this code work? I'm not getting an error, but nothing happens
Option Explicit
Sub extowo()
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim BMRange As Word.Range
Dim Bookmark1 As Excel.Range
Dim wObj As Word.Application
On Error Resume Next
' Get existing instance of Word if it exists.
Set wObj = GetObject(, "Word.Application")
If Err <> 0 Then
' If GetObject fails, then use CreateObject instead.
Set wObj = CreateObject("Word.Application")
End If
'Create an instance of word
Set wdDoc = wdApp.Documents.Open("C:\Users\dnykg\Documents\Custom Office Templates\Agent Invoice - Bookmarks.dotm")
Set Bookmark1 = ThisWorkbook.Sheets("Sheet2").Range("A7:A14") 'Set your word bookmark
Set BMRange = wdDoc.Goto(what:=wdGoToBookmark, Name:="Bookmark1")
'Pass your excel range to the word bookmark
BMRange.Text = Bookmark1 'Save your word doc
With wdApp.ActiveDocument.Visible
.SaveAs ThisWorkbook & "\Program Agreement"
End With
'Close out word
wdApp.Quit
Set BMRange = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub
Option Explicit
Sub extowo()
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim BMRange As Word.Range
Dim Bookmark1 As Excel.Range
Dim wObj As Word.Application
On Error Resume Next
' Get existing instance of Word if it exists.
Set wObj = GetObject(, "Word.Application")
If Err <> 0 Then
' If GetObject fails, then use CreateObject instead.
Set wObj = CreateObject("Word.Application")
End If
'Create an instance of word
Set wdDoc = wdApp.Documents.Open("C:\Users\dnykg\Documents\Custom Office Templates\Agent Invoice - Bookmarks.dotm")
Set Bookmark1 = ThisWorkbook.Sheets("Sheet2").Range("A7:A14") 'Set your word bookmark
Set BMRange = wdDoc.Goto(what:=wdGoToBookmark, Name:="Bookmark1")
'Pass your excel range to the word bookmark
BMRange.Text = Bookmark1 'Save your word doc
With wdApp.ActiveDocument.Visible
.SaveAs ThisWorkbook & "\Program Agreement"
End With
'Close out word
wdApp.Quit
Set BMRange = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub