Copying Excel data to Word, Only executes once. (Error 462)

[whiteprw]

Hey Everyone, thanks for helping in advance, basically I have created a macro to copy a quote from an excel sheet into a Microsoft word template.

From which whoever's using it can then finalise save and close. It works fine the first time the macro is run but the second time it errors (run time error 462 'the remote server machine is unavailable or does not exist.')

I have been browsing the forums and gathered that it has something to do with the wdApp still being linked but I can't seem to figure it out. (The word document is closed by whoever is using it before re-running the macro)

P.S I know my coding is terrible it is taken from snippets off the web I'm slowly trying to clean it up as I learn VBA. Thanks AGAIN!



Sub SendRangeToDoc()
Dim wdApp As Word.Application
Dim WdDoc As String
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C6:C6").Copy
'Establish link to Word
WdDoc = "Y:\QUOTES\New Quote Templates\Ducted Units\MacroTemplates\PDFdaikinMACROONLY.doc"
If Dir(WdDoc) <> "" Then
Set wdApp = New Word.Application
wdApp.Documents.Open "Y:\QUOTES\New Quote Templates\Ducted Units\MacroTemplates\PDFdaikinMACROONLY.doc"
wdApp.Visible = True
With wdApp
BmkNm = "MacroQuoteNo"
With ActiveDocument ERROR OCCURS HERE!!
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
Else
MsgBox "Bookmark: " & BmkNm & " not found."
End If
End With
End With
Else
MsgBox "File: " & WdDoc & " not found."
End If
'Release Word object
Set wdApp = Nothing


'If data on this worksheet changes, refresh the pivot table
Sheets("MacroStuff").PivotTables("PivotTable1").RefreshTable


'Quote2'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C7:C7").Copy
With wdApp
BmkNm = "MacroQuoteNo2"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Quote3'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C5:C5").Copy
With wdApp
BmkNm = "MacroQuoteNo3"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Same code starting for Name'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C11:C11").Copy
With wdApp
BmkNm = "MacroName"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial DataType:=2
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Same code starting for Name2'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C14:C14").Copy
With wdApp
BmkNm = "MacroName2"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Same code starting for Name3'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C15:C15").Copy
With wdApp
BmkNm = "MacroName3"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Address'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C12:C12").Copy
With wdApp
BmkNm = "MacroAddress"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Address2'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C16:C16").Copy
With wdApp
BmkNm = "MacroAddress2"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Suburb'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C13:C13").Copy
With wdApp
BmkNm = "MacroSuburb"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Suburb2'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C17:C17").Copy
With wdApp
BmkNm = "MacroSuburb2"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Date'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C8:C8").Copy
With wdApp
BmkNm = "MacroDate"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Date2'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C9:C9").Copy
With wdApp
BmkNm = "MacroDate2"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Cost'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C21:C21").Copy
With wdApp
BmkNm = "MacroCost"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial DataType:=2
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Cost2'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C22:C22").Copy
With wdApp
BmkNm = "MacroCost2"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Total Outlets RAG Zones'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C23:C23").Copy
With wdApp
BmkNm = "MacroTotals"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial DataType:=2
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Return Air Grilles'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C30:C30").Copy
With wdApp
BmkNm = "MacroReturnAirGrille"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial DataType:=2
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'SalesMan'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C1:C1").Copy
With wdApp
BmkNm = "MacroSalesMan"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Position'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C2:C2").Copy
With wdApp
BmkNm = "MacroPosition"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Phone'
'Copy range
ActiveWorkbook.Sheets("MacroStuff").Range("C18:C18").Copy
With wdApp
BmkNm = "MacroPhone"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial DataType:=2
End If
End With
End With
'Release Word object
Set wdApp = Nothing

'Unit 1'
If ActiveWorkbook.Sheets("MacroStuff").Range("F43:F43") > 0 Then
ActiveWorkbook.Sheets("MacroStuff").Range("D53:E57").Copy
With wdApp
BmkNm = "MacroUnit1"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing
End If

If ActiveWorkbook.Sheets("MacroStuff").Range("F43:F43") = 0 Then
Set wdApp = GetObject(, "Word.Application")
Call wdApp.Run(strFile & "Macro1")
End If

'Unit 2'
If ActiveWorkbook.Sheets("MacroStuff").Range("F44:F44") > 0 Then
ActiveWorkbook.Sheets("MacroStuff").Range("D59:E63").Copy
With wdApp
BmkNm = "MacroUnit2"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing
End If

If ActiveWorkbook.Sheets("MacroStuff").Range("F44:F44") = 0 Then
Set wdApp = GetObject(, "Word.Application")
Call wdApp.Run(strFile & "Macro2")
End If

'Unit 3'
If ActiveWorkbook.Sheets("MacroStuff").Range("F45:F45") > 0 Then
ActiveWorkbook.Sheets("MacroStuff").Range("D65:E69").Copy
With wdApp
BmkNm = "MacroUnit3"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing
End If

If ActiveWorkbook.Sheets("MacroStuff").Range("F45:F45") = 0 Then
Set wdApp = GetObject(, "Word.Application")
Call wdApp.Run(strFile & "Macro3")
End If


'Unit 4'
If ActiveWorkbook.Sheets("MacroStuff").Range("F46:F46") > 0 Then
ActiveWorkbook.Sheets("MacroStuff").Range("D71:E75").Copy
With wdApp
BmkNm = "MacroUnit4"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing
End If

If ActiveWorkbook.Sheets("MacroStuff").Range("F46:F46") = 0 Then
Set wdApp = GetObject(, "Word.Application")
Call wdApp.Run(strFile & "Macro4")
End If


'Unit 5'
If ActiveWorkbook.Sheets("MacroStuff").Range("F47:F47") > 0 Then
ActiveWorkbook.Sheets("MacroStuff").Range("D77:E81").Copy
With wdApp
BmkNm = "MacroUnit5"
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
.Bookmarks(BmkNm).Range.PasteSpecial Link:=False, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End With
End With
'Release Word object
Set wdApp = Nothing
End If

If ActiveWorkbook.Sheets("MacroStuff").Range("F47:F47") = 0 Then
Set wdApp = GetObject(, "Word.Application")
Call wdApp.Run(strFile & "Macro5")
End If


End Sub

[Kenneth Hobs]

Welcome to the forum! When posting vba code, please paste between vba code tags. Click the VBA button in the toolbar of your post to insert the tags.

The problem has to do with how you create the word application and the document and the reference set or not set.

Look at some of these examples and how CreateObject() and GetObject() are used. At the end of those code examples, notice how the objects are set to Nothing.

Option Explicit
'TypeText method
' http://www.excelforum.com/excel-prog...ml#post1946784
' http://www.excelforum.com/showthread.php?p=1946784
' http://vbaexpress.com/forum/showthread.php?p=169877
' http://vbaexpress.com/forum/showthread.php?t=24693
' http://www.excelforum.com/excel-prog...age-setup.html

'Copy from Excel, paste to Word
'Lucas, http://vbaexpress.com/forum/showthread.php?p=178364

'FormFields
' http://www.mrexcel.com/forum/showthread.php?p=1639696
' http://www.mrexcel.com/forum/showthread.php?t=333200
' http://www.excelforum.com/excel-prog...from-word.html
' Content Controls
' http://www.vbaexpress.com/forum/showthread.php?t=39654

'Add Hyperlink to Bookmark
' http://www.excelforum.com/excel-prog...ml#post2006430
'Steiner, http://www.vbaexpress.com/kb/getarticle.php?kb_id=126
'Colin_L, http://www.mrexcel.com/forum/showthread.php?t=358054

'Save OLEObject as MSWord Document
' http://vbaexpress.com/forum/showthread.php?t=21619

'Add Table to MSWord
' http://vbaexpress.com/forum/showthread.php?t=23975
' http://vbaexpress.com/forum/showthread.php?p=168731

'Import Word Tables
'vog, http://www.mrexcel.com/forum/showthread.php?t=382541

'Save OLEObject as MSWord DOC
' http://vbaexpress.com/forum/showthread.php?t=21619

'Get Optionbutton info from MSWord DOC
' http://vbaexpress.com/forum/showthread.php?t=22454

'FindReplace Text
' http://www.excelforum.com/excel-prog...-ms-excel.html
' http://www.vbaexpress.com/forum/showthread.php?t=38958
' http://www.vbaexpress.com/forum/showthread.php?p=250215
' http://www.vbaexpress.com/forum/showthread.php?t=42833
' http://support.microsoft.com/kb/240157
' http://word.tips.net/T001833_Generat...currences.html

' http://www.excelforum.com/excel-prog...o-to-word.html

'Bookmarks
' http://vbaexpress.com/forum/showthread.php?p=185718
'Colin_L, http://www.mrexcel.com/forum/showthread.php?t=358054
' http://www.vbaexpress.com/forum/showthread.php?p=253277

'Mail Merge
' http://www.excelforum.com/excel-prog...rom-excel.html
' http://www.excelforum.com/excel-prog...-document.html
'Word 's Catalogue/Directory Mailmerge facility (the terminology depends on the Word version). _
To see how to group records with any mailmerge data source supported by Word, _
check out my Microsoft Word Catalogue/Directory Mailmerge Tutorial at:
' http://lounge.windowssecrets.com/ind...owtopic=731107
' or
' http://www.gmayor.com/Zips/Catalogue%20Mailmerge.zip