Thanks Paul,
When I apply my datasource to your revised version of my report ... I have no more blank pages and the Page of Pages fields populate. But, the times are all decimals.
This report was a result of merging directly from Word.
Feel free to have a look at this document by downloading it from here.
Interestingly, when I execute this merge
by way of my Excel VBA application, I get different results. I get multiple records per page but the Page of Pages does populate.
This document can be downloaded here.
I am leaning towards Excel being the problem? As I look closer at the code, I do see reference to page breaks....
For what it's worth, here is the code from Excel that is applying the merge ...
Code:
Sub merge2(ByVal i As Long, ByVal rpt_od As String, objWord As Object, ByVal dest As Long)
Dim oDoc As Object, oDoc2 As Object
Dim StrSQL As String, fName As String, StrSrc As String, strFilename As String, myPath As String
Dim qfile As String, st_srchfn As String, wb_qfile2 As Workbook, itype As String, isubresp As String
'Dim wb_qfile2 As Workbook
Dim HdFt As Variant
Const wdSendtToNewDocument = 0
Const wdSendToPrinter = 1
Const wdFormLetters = 0
Const wdDirectory = 3
Const wdMergeSubTypeAccess = 1
Const wdOpenFormatAuto = 0
work_fn = ws_vh.Range("N2")
Set wb_nwb = Workbooks(work_fn)
'create workorders folder
myPath = "u:\PWS\Parks\Parks Operations\Sports\Sports17\WORKORDERS\" & Format(ws_vh.Range("B17"), "ddd dd-mmm-yy")
If Dir(myPath, vbDirectory) = "" Then 'if not already created ...
MkDir myPath
End If
'close data file
st_srchfn = "u:\PWS\Parks\Parks Operations\Sports\Sports17\DATA\" & ws_vh.Range("N2")
If wb_nwb Is Nothing Then
MsgBox wb_nwb & " is NOT open."
Else
wb_nwb.Close True 'saves data workbook after TYPE was updated for GS
End If
itype = Right(ws_th.Range("A" & i), 2)
isubresp = Left(ws_th.Range("A" & i), 3)
If itype = "DR" Then
fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\DR15v1.docx"
ElseIf itype = "DT" Then
fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\DT15v1.docx"
ElseIf itype = "FR" Then
fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\FR15v1.docx"
ElseIf itype = "FT" Then
fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\FT15v1.docx"
ElseIf itype = "CR" Then
fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\CR15v1.docx"
ElseIf itype = "CT" Then
fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\CT15v1.docx"
ElseIf itype = "GS" Then
If isubresp = "HPE" Or isubresp = "HPL" Then
fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\GS15v1_GSH.docx" 'Passive : Hillside
Else
fName = "u:\PWS\Parks\Parks Operations\Sports\Sports17\REPORTS\v1\GS15v1_GS.docx" 'Passive : Wloo Park
End If
Else
fName = "U:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\GS15v1_GM.docx"
End If
StrSrc = "u:\PWS\Parks\Parks Operations\Sports\Sports17\DATA\" & ws_vh.Range("N2")
StrSQL = "SELECT * FROM [DATA$] 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
'page break routine only for sports reports
If Left(itype, 1) <> "G" Then 'exclude GS reports
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 If
End With
Set oDoc2 = objWord.activedocument
'save newly created document
With oDoc2
myPath = "u:\PWS\Parks\Parks Operations\Sports\Sports17\WORKORDERS\" & Format(ws_vh.Range("B17"), "ddd dd-mmm-yy")
.SaveAs myPath & "\" & rpt_od & ".docx"
If dest = 2 Then
.PrintOut
End If
'.Close
End With
Set oDoc = Nothing: Set oDoc2 = Nothing ': Set objWord = Nothing
End Sub
Hopefully having posted external links to my files are OK. I do need to maintain control over their access, and this is the only way I can see doing it.