Thanks Paul, i didn't realize it was a simple as just typing it in. I know for {PAGE} and {NUMPAGES} I hadn't typed them but rather selected them from a list somewhere and they were inserted in the document.
I realize you are leaning toward a problematic footer (based on the limited familiarization you have with the report and data etc) , and I'm skepticale because I have copied and pasted the same footer between 7 other similar reports, that draw from the same data, and present similarly (just a different set of data) and they populate just as expected with {PAGE} and {NUMPAGES}.
As I was fixing some bugs in my Excel application (which I've been developing now for 3 years) I came across this. I'm wondering if this is the culprit as it references the report's headers and footers.
In post #10 you were kind enough to offer to take a look at the report. Maybe if the offer stands I can take you up on that offer since I think there is enough questions around it that it might be more worth your time. (stand by for the file ... it is not with me right now)
[s]Problem 1 - {Page} of {NumPages} as discussed in this thread.[/s]
- {SECTION} worked noiw that I knew how to apply it.
Problem 2 -
see this post File added here
[s]Problem 3 - IWhen I print these reports there is always an empty page (but still with header/hooter) printed.[/s]
- Solved I think.
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") And (itype <> "DT") 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
This is code that I believe you helped me with earlier designed (if I understand correctly) to ensure only one record per page, unlike the other reports that fit as many records on a page as will fit.
Could this be contributing to the unique problem associated with this report (itype = DT)?