Closing Word From Excel

[Saps]

Excel 2003

i wrote code that transfers a list in excel and then mail merges it word to produce labels. At the end of this I would like it to close word without saving anything. I haven't had much luck. I have tried the following code but it does not work.


'This is used at the beginning of the code

Dim WdApp As Word.Application
Dim WdDoc As Word.Document
Set WdApp = CreateObject("Word.Application")Set WdDoc = Nothing

'this is used at the end

WdApp.Quit
Set WdApp = Nothing

 

[Datsmart]

Try this:

WdDoc.Close savechanges:=False ‘This closes the document with out saving changes
wdApp.Quit ‘Closes teh word application

 

[Saps]

Ok I am going to post my entire problem. As I said, I am trying to write code that takes and excel spreadsheet, mail merges into word and prints out labels with one click of an active x button. I have 3 problems that I haven't been able to figure out yet.

1. I haven't been able to get word to close automatically. It sits on that line of code for a min but then nothing happens.

2. Now the excel spreadsheet that I use as an label queue won't save.

3. 3 extra blank sheets print out. I believe it may have somethig to do with the label mail merge template but i haven't figured out where yet.

Here is the code

Private Sub CommandButton1_Click()

Dim LastCell As Range

If ActiveSheet.Range("B2") = "" Then
    MsgBox "There is nothing to print out"
        End
End If
    


ActiveSheet.Range("A65536").End(xlUp).Select
Set LastCell = ActiveCell


Dim RNG As Integer
Dim a As Integer
Dim HomeCell As Range

Set HomeCell = Range("B2")
Range("A2", LastCell).Select
RNG = Selection.Rows.Count + 100
Range("A2").Select
For a = 1 To RNG
If ActiveCell = "x" Then
    ActiveCell = ""
    ActiveCell.EntireRow.Insert
    Range(ActiveCell.Offset(1, 1), ActiveCell.Offset(1, 8)).Copy
 
        Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 8)).PasteSpecial
            ActiveCell.Offset(0, -1).Select
                        
'        Range("A2", LastCell).Select
'    RNG = 0
'    RNG = Selection.Rows.Count
'    Range("A2").Select
    End If

ActiveCell.Offset(1, 0).Select

Next a

ActiveSheet.Range("A2").Select

End Sub

Private Sub CommandButton2_Click()


If ActiveSheet.Range("B2") = "" Then
    MsgBox "There is nothing to print out"
        End
End If
        


Workbooks.Open Filename:="r:\Shipment Planning Labels.xls"
Windows("Shipment Planning Labels.xls").Activate

ActiveSheet.Select
ActiveSheet.Cells.ClearContents
    
Windows("Shipment Picking.xls").Activate
ActiveSheet.Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
'If ActiveSheet.Range("A3") <> "" Then
'ActiveSheet.Range("A2").Select
'    Range(Selection, Selection.End(xlDown)).Select
'    Range(Selection, Selection.End(xlToRight)).Select
'        Selection.Paste
Workbooks("Shipment Planning Labels.xls").Sheets("Labels").Range("a2").PasteSpecial
    
'ActiveSheet.Range("b2").Select
'    ActiveSheet.Selection.PasteSpecial
    
Workbooks("Shipment Planning Labels.xls").Activate
    ActiveSheet.Range("A1") = "Item"
    ActiveSheet.Range("B1") = "Desc"
    ActiveSheet.Range("C1") = "Job"
    ActiveSheet.Range("D1") = "Serial"
    ActiveSheet.Range("E1") = "Lot"
    ActiveSheet.Range("F1") = "Qty"
    ActiveSheet.Range("G1") = "Bin"
    ActiveSheet.Range("H1") = "Pick List"
  
        
ActiveWorkbook.Save

ActiveWorkbook.Close

Workbooks("Shipment Picking.xls").Activate
    Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToRight)).Select
        Selection.ClearContents
        
Call OpenWord

Call MailMergePicking
Call CloseWord

'this closes word
'Dim wrdApp As Word.Application
'
'Set wrdApp = CreateObject("Word.Application")
'Dim wrdDoc As Word.Document
'Set wrdDoc = wrdApp.Documents
''wrdDoc.Close savechanges:=False
'wrdApp.Quit


    
MsgBox "Your labels are printing."


End Sub



Sub OpenWord()


Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim i As Integer
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Add


End Sub

Sub MailMergePicking()
' MailMerge Macro
' Macro recorded 5/8/2007 by


Application.DisplayAlerts = wdAlertsNone

ChangeFileOpenDirectory "r:\merge templates"
    Documents.Open Filename:="""Pick List Labels.dot""", ConfirmConversions:= _
        False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
        
Application.DisplayAlerts = wdAlertsAll

ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "r:\shipment planning labels.xls" _
        , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=r:\turbineworks\recieving\shipment planning labels.xls;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";J" _
        , SQLStatement:="SELECT * FROM `Labels$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
    With ActiveDocument.MailMerge
        .Destination = wdSendToPrinter
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
   

    
End Sub

Sub CloseWord()
Dim objWord As Word.Application
Dim doc As Word.Document

Set objWord = New Word.Application

Set doc = objWord.Documents.Open(Filename:="r:\merge templates\pick list labels.dot", Visible:=False)



doc.Close False
objWord.Quit

Set doc = Nothing
Set objWord = Nothing

End Sub

 

[Datsmart]

As for your Word application not closing:
Your OpenWord and CloseWord codes are working with two different instances of Word, one called "wrdApp" and the other called "objWord".
They also use two different documents, one called "wrdDoc" and the other "doc".
You might keep all your code in one macro so you don't get your applications and documents mixed up. Then your close code will work on the proper document and application.

 

[Saps]

I have had the code named the same way. i just have been looking for solutions on and tried this code that I found online. Thanks anyways.