windows - VBA: Microsoft Word process does not exit after combining many Word files into one -

i'm trying merge many word files one. doing inside vba routine in ms excel. word files in folder named "files" , want create new file "combinedfile.docx" in folder one-level above that. problem i'm facing regarding how word process behaves after merging files (whether or not exits after execution of vba function). on machines, process works fine (except has page 2 , last page blank), while on others, merged document contains blank page , process manager shows word process started vba function still running.

1. i not used vba programming , can see in code below, don't know right way close open document , exit open word process. if @ i've done , suggest way solve problem, helpful.

2. i interested know if right way merge several word files. if there's better way, please let me know.

     'the flow:     '  start word process create blank file "combinedfile.docx"     '  loop on documents in "files" folder , following:     '    open file, insert @ end of combinedfile.docx, insert pagebreak     '  close file , exit word process      filesdir = activeworkbook.path + "\" + "files\"     thisdir = activeworkbook.path + "\"     singlefile = thisdir + "combinedfile.docx"      'if exists, delete     if fileexists(singlefile)       setattr singlefile, vbnormal       kill singlefile     end if      dim wordapp word.application     dim singledoc word.document     set wordapp = new word.application     set singledoc = wordapp.documents.add     wordapp.visible = true     singledoc.saveas filename:=singlefile     singledoc.close    'i both , line below (is necessary?)     set singledoc = nothing     wordapp.quit     set wordapp = nothing      joinfiles filesdir + "*.docx", singlefile      sub joinfiles(alldocs string, singledoc string)       dim wordapp word.application       dim doc word.document       set wordapp = new word.application       set doc = wordapp.documents.open(filename:=singledoc)       dim filesdir string       filesdir = activeworkbook.path + "\" + "files\"        docpath = dir(alldocs, vbnormal)        while docpath  ""         doc.bookmarks("\endofdoc").range.insertfile (filesdir + docpath)         doc.bookmarks("\endofdoc").range.insertbreak type:=wdpagebreak         docpath = dir       wend       doc.save       doc.close       set doc = nothing       wordapp.quit       set wordapp = nothing       end sub 

i propose optimize code in following ways:

• open wordapp once , move files without closing/reopening
• no need kill combineddoc upfront, overwritten new file
• no need word.document object, can done in word.application object

so code gets lot simpler:

sub merge() dim wordapp word.application dim filesdir string, thisdir string, singlefile string, docpath string dim fnarray() string, idx long, jdx long ' new 11-apr-2013      filesdir = activeworkbook.path + "\" + "files\"     thisdir = activeworkbook.path + "\"     singlefile = thisdir + "combinedfile.docx"     set wordapp = new word.application  ' new 11-apr-2013 start     ' read in array     idx = 0     redim fnarray(idx)     fnarray(idx) = dir(filesdir & "*.docx")     while fnarray(idx) <> ""         idx = idx + 1         redim preserve fnarray(idx)         fnarray(idx) = dir()     loop     redim preserve fnarray(idx - 1) ' rid of last blank element     bubblesort fnarray ' new 11-apr-2013 end      wordapp         .documents.add         .visible = true  ' removed 11-apr-2013 docpath = dir(filesdir & "*.docx") ' removed 11-apr-2013 while docpath <> "" ' removed 11-apr-2013     .selection.insertfile filesdir & docpath ' removed 11-apr-2013     .selection.typebackspace ' removed 11-apr-2013     .selection.insertbreak wdpagebreak ' removed 11-apr-2013     docpath = dir ' removed 11-apr-2013 loop  ' new 11-apr-2013 start         jdx = 0 idx - 1             .selection.insertfile filesdir & fnarray(jdx)             .selection.typebackspace             .selection.insertbreak wdpagebreak         next jdx ' new 11-apr-2013 end          .selection.typebackspace         .selection.typebackspace         .selection.document.saveas singlefile         .quit     end     set wordapp = nothing end sub  ' new 11-apr-2013 start sub bubblesort(arr) dim strtemp string dim idx long, jdx long dim vmin long, vmax long      vmin = lbound(arr)     vmax = ubound(arr)      idx = vmin vmax - 1         jdx = idx + 1 vmax             if arr(idx) > arr(jdx)                 strtemp = arr(idx)                 arr(idx) = arr(jdx)                 arr(jdx) = strtemp             end if         next jdx     next idx end sub ' new 11-apr-2013 end 

edit 11-apr-2013 removed original comments in code added array , bubblesort logic guarantee files retrieved in alphabetical order