Closing Word From Excel

Saps

New Member
Joined
Jul 30, 2006
Messages
13
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
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
Code:
WdApp.Quit
Set WdApp = Nothing
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Datsmart

Well-known Member
Joined
Jun 19, 2003
Messages
7,985
Try this:
Code:
WdDoc.Close savechanges:=False ‘This closes the document with out saving changes
wdApp.Quit ‘Closes teh word application
 

Saps

New Member
Joined
Jul 30, 2006
Messages
13
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
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

Well-known Member
Joined
Jun 19, 2003
Messages
7,985
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

New Member
Joined
Jul 30, 2006
Messages
13
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,361
Messages
5,635,808
Members
416,884
Latest member
leeshjay

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
Top