Need help please

pwwato

New Member
Joined
Jun 10, 2017
Messages
40
Hi all thanks for taking a look and any help provided. The object of this sub is to mailmerge to a word documeny depending on a listbox selection. the sub works fine upto a certain point but having trouble completing it fully with added functions. the sub runs to the end as it stands with the lines
Apostrophed
out and will produce the document required using a word dotx mailmerge template, but it does not create a new document for the template as if it was run from word. Instead it edits the original document? if i try to use a close or save command in the code after finishing and producing the document excel crashes, if i save or close from the opened document and omit the save or close command everything is fine, also if use a word file dialog box to choose either the file to open or save? excel crashes after i close the dialog yet it saves the file or opens the correct one in word before it crashes.
i am so confused have been trying to get this to work correctly for what seems like ages looked every where tryed different ways of doing these things but get same results HELP! PLEASE!!!!
Code:
Sub RunMerge()

    Application.ScreenUpdating = False
Dim TBook As String
Dim TSheet As String
Dim TRange As Range
Dim TMatch As String
Dim DO2T As Integer
Dim TArray() As Variant
Dim SList() As Variant
Dim ws As Worksheet
Dim wsnew As Worksheet
Dim lastrow As String

Set ws = Sheets("Contacts")
    ws.Copy After:=Sheets("Contacts")
Set wsnew = Sheets(Sheets("Contacts").Index + 1)
    wsnew.Name = "Temp"
    TBook = ("YES V1DB.xlsm")
    TSheet = ("Temp")
Set TRange = Range("A2:T2")
    TMatch = "GA326"   [COLOR=#ff0000]This is where the listbox command will be at present the ref i have put in is for testing as it is a representation of the listbox result[/COLOR]
    DO2T = 2
Call create_array(TBook, TSheet, TRange, TMatch, DO2T, TArray) [COLOR=#ff0000]this function creates an array and finds the ref and redims the array to that row data only
[/COLOR]
    Application.DisplayAlerts = False
    Application.Workbooks(TBook).Sheets("Temp").Delete
    Application.DisplayAlerts = True
    Application.Workbooks(TBook).Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    Application.Workbooks(TBook).Sheets("Temp").Range("A2:j2") = TArray
    Application.Workbooks(TBook).Sheets("Temp").Range("A:A").Delete
    Application.Workbooks(TBook).Sheets("Temp").Range("A2:J2").Copy Destination:=Sheets("Mailmerge").Range("A2")[COLOR=#ff0000]Above and below copies the resulting array to a temp sheet removes a column and then copies to the mailmerge list[/COLOR]
 Erase TArray
    Application.DisplayAlerts = False
    Application.Workbooks(TBook).Sheets("Temp").Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
[COLOR=#ff0000]Mail merge command[/COLOR]
  Dim strMainDocName As String
    Dim strResDocName As String
    Dim docMain As Word.Document
    Dim docResult As Word.Document
    Dim strOutFolder As String
    Dim strInfolder As String
    Dim bNewInstance As Boolean
    Dim objWord As Word.Application
    Dim savename As Word.Document
    'set file and folder paths.
    strInfolder = "C:\Users\York Elevator Servic\Desktop\YES Custom Office Templates\"
    strOutFolder = "C:\Users\York Elevator Servic\Desktop\YES Custom Office Templates\Letter\"
    strMainDocName = "YES LETTER DATA.dotx"
    
   [COLOR=#ff0000] 'avoid creating multiple instances of the Word application first thought here was to check if word was open but any getobject code i use on second line like[LEFT][COLOR=#303336][FONT=Consolas] [/FONT][/COLOR][FONT=Consolas]GetObject[/FONT][FONT=Consolas](,[/FONT][FONT=Consolas] [/FONT][FONT=Consolas]"Word.Application"[/FONT][FONT=Consolas]) crashes so have had to settle with opening new word app[/FONT][/LEFT][/COLOR][COLOR=#ff0000][/COLOR]
    On Error Resume Next 'suppress error checking for the next instruction
    Set objWord = New Word.Application
    On Error GoTo 0 'resume error checking
    
    If objWord Is Nothing Then
        no instance, so make a new one
        Set objWord = New Word.Application
        bNewInstance = True
    End If
    objWord.Visible = True
    
    
    strResDocName = Replace(strMainDocName, ".docx", "_result.docx")
    
   [COLOR=#ff0000] ' open the main document any open file dialog command crashes once file selected[/COLOR]
    Set docMain = objWord.Documents.Open(strInfolder & "\" & strMainDocName)
    
   [COLOR=#ff0000] 'do the merge[/COLOR]
    With docMain.MailMerge
    [COLOR=#ff0000]  '.Execute             causes crash but works without it?[/COLOR]
    End With
[COLOR=#ff0000]    'savename = Application.GetSaveAsFilename _
        (Title:="Please choose Save Name", _
        FileFilter:="Word Files *.docx (*.docx),")
    'If savename = False Then
        'MsgBox "No file specified.", vbExclamation, "Error"
        'Exit Sub                                                                                              These are some of the ways i have tried to either save or close document all result in a crash

    'capture the result document into a specific document object variable
    'Set docResult = objWord.ActiveDocument
    'closing and saving
    'docMain.Close wdDoNotSaveChanges
    'docResult.SaveAs strOutFolder & "\" & strResDocName
    'docResult.Close wdDoNotSaveChanges
    
    'close application unless Word was already running
    'If bNewInstance Then
        ' objWord.Quit
    'End If[/COLOR]
End Sub


If i run the code with just the black text as i have said it runs and completes ok but need to save the document in the word window and close which is not ideal as if you forget to saveas, it changes the template. would also like to get file dialog boxes working for future use as i make different word templates later.

Really needsome help on this guys and gals so any input other than telling me im an idiot:LOL: which im fully aware of will be appreciated.
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

pwwato

New Member
Joined
Jun 10, 2017
Messages
40
Sorry forgot to add that all crashes show no errors just excel has stopped and we are looking for a solution blah blah blah
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,784
Office Version
  1. 2010
Platform
  1. Windows
If instead of ...

Code:
Set docMain = objWord.Documents.Open(strInfolder & "\" & strMainDocName)

... you do ...

Code:
Set docMain = appWd.Documents.Add(Template:=strInfolder & "\" & strMainDocName)

... then you don't need to worry about saving over the template.
 

pwwato

New Member
Joined
Jun 10, 2017
Messages
40
Thanks for that much appreciated stopped the template issue, would still like to get the file dialog working as its a aspect i will need to add at somepoint and the close word part, the ideal scenario for this sub would be to open file daiolog letting you select the file to merge and then once merged add the ref eg "GA326" as name and save into a folder selected through a file dialog or thats what i am aiming for lol

Much appreciated swapped appwd to objword to keep my code same but the add instead of open made the difference.:LOL:
 

pwwato

New Member
Joined
Jun 10, 2017
Messages
40

ADVERTISEMENT

sorry and Template part!! in brackets
 

pwwato

New Member
Joined
Jun 10, 2017
Messages
40
May have spoke to soon as the document 1 it opens does not have the mail merge complete just shows the fields adrblock and greeting, if i revert the code back the document although it is the original has the field filled in correctly?
 

Watch MrExcel Video

Forum statistics

Threads
1,129,317
Messages
5,635,527
Members
416,862
Latest member
MGDlite

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