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
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!!!!
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
which im fully aware of will be appreciated.
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 SubIf 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
which im fully aware of will be appreciated.
