Let us revisit this code ...
Code:
Sub merge2(ByVal i As Long, ByVal ws_vh As Object, ByVal rpt_od As String, objWord As Object)
'Dim objWord As Object, oDoc As Object
Dim oDoc As Object
Dim StrSQL As String, fName As String, StrSrc As String, strFilename As String
Dim ws_th As Worksheet
Dim qfile As String, st_srchnfn As String, wb_qfile2 As Workbook
Const wdSendtToNewDocument = 0
Const wdSendToPrinter = 1
Const wdFormLetters = 0
Const wdDirectory = 3
Const wdMergeSubTypeAccess = 1
Const wdOpenFormatAuto = 0
'Const itype As String = "DR"
'Const isubresp As String = "WPL"
qfile2 = ws_vh.Range("B4")
st_srchfn = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & qfile2
Set wb_qfile2 = Workbooks(qfile2)
If wb_qfile2 Is Nothing Then
MsgBox qfile2 & " is NOT open."
Else
'MsgBox qfile2 & " is open"
wb_qfile2.Close False
End If
Set ws_th = Workbooks("Sports15b.xlsm").Worksheets("TEMP_HOLD")
itype = Right(ws_th.Range("A" & i), 2)
isubresp = Left(ws_th.Range("A" & i), 3)
If itype = "DR" Then
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\DR15v1.docx"
ElseIf itype = "DT" Then
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\DT15v1.docx"
ElseIf itype = "FR" Then
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\FR15v1.docx"
ElseIf itype = "FT" Then
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\FT15v1.docx"
ElseIf itype = "CR" Then
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\CR15v1.docx"
Else
fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\CT15v1.docx"
End If
StrSrc = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & ws_vh.Range("B4")
StrSQL = "SELECT * FROM [CORE$] WHERE [TYPE]='" & itype & "' AND [SIG_CREW]='" & isubresp & "' " & _
"ORDER BY [STARTS] ASC, [COMPLEX] ASC, [UNIT] ASC"
'Set objWord = CreateObject("Word.Application")
With objWord
.DisplayAlerts = False
.Visible = True
Set oDoc = .documents.Open(Filename:=fName, ConfirmConversions:=False, _
ReadOnly:=True, AddToRecentFiles:=False, Visible:=True)
With oDoc
With .MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendtToNewDocument
.SuppressBlankLines = True
.OpenDataSource Name:=StrSrc, AddToRecentFiles:=False, LinkToSource:=False, ConfirmConversions:=False, _
ReadOnly:=True, Format:=wdOpenFormatAuto, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"User ID=Admin;Data Source=" & StrSrc & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";", _
SQLStatement:=StrSQL, SQLStatement1:="", SubType:=wdMergeSubTypeAccess
.Execute Pause:=False
End With
.Close False
End With
.DisplayAlerts = True
With .ActiveDocument
If .Sections.Count > 1 Then
For Each HdFt In .Sections(.Sections.Count).Headers
If HdFt.Exists Then
HdFt.Range.FormattedText = .Sections(1).Headers(HdFt.Index).Range.FormattedText
HdFt.Range.Characters.Last.Delete
End If
Next
For Each HdFt In .Sections(.Sections.Count).Footers
If HdFt.Exists Then
HdFt.Range.FormattedText = .Sections(1).Footers(HdFt.Index).Range.FormattedText
HdFt.Range.Characters.Last.Delete
End If
Next
End If
Do While .Sections.Count > 1
.Sections(1).Range.Characters.Last.Delete
DoEvents
Loop
.Range.Characters.Last.Delete
End With
End With
Set oDoc2 = objWord.ActiveDocument
With oDoc2
myPath = "H:\PWS\Parks\Parks Operations\Sports\Sports15\WORKORDERS\" & Format(ws_vh.Range("B2"), "ddd dd-mmm-yy")
.SaveAs myPath & "\" & rpt_od & ".docx"
End With
AppActivate "Microsoft Excel"
Set oDoc = Nothing: Set oDoc2 = Nothing ': Set objWord = Nothing
'End If
End Sub
In my excel application, I have a loop that calls this merge routine 'x' amount of times. Each loop has a calls for the need for a different report as defined by "rpt_od".
In my example, three different reports need be created. rpt_od = HPE-DT, RPE_FR, and WPE-FR. The merge routine will be called three times.
Here is my issue ... I believe it has something to do with either the .close false statement (not closing the newly created document), or the With .ActiveDocument line (not identifying the correct document as being the active document).
When HPE-DT is created, it is named and saved as HPE-DT.docx. It remains accessible, ie not closed. The next merge routine is called to merge to the document for RPE-FR. The merge is successful and a new document is created. However, it is not saved. The former HPE-DT is resaved with the name RPE-FR.docx. The newly created document sits open named "letters2.docx" and is not saved. When I run the merge routine for the third report, WPE-FR, the RPE-FR.docx is resaved as WPE-FR. The most recently created document sits open named "letters3.docx"
I now have the same document saved under three different names. Only the first one is the proper one. I have two unsaved proper documents. I have to save them as and overwrite the incorrect file.
What must I do to correct this situation? I would like to have the documents saved as created, but remain open for the user to preview and edit before printing.
Thank you all in advance.