OTWarrior
01-12-2017, 08:23 AM
I am trying to build a reporting tool, that will allow the user to create a number of queries (from an imported spreadsheet).
The number of and values of these queries will be different, so I can't hard code much. It all has to be dynamic.
I am at the point where I can generate the queries easily enough, but the issue is how to present them in a suitable format.
I could export them one at a time to different reports, but it needs to be in a word document format (so the built in RTF exporter won't work).
I'll be exporting the queries directly, as well as strings, so it will need to be able to export the queries directly into Word. I have the following code so far
For creating a report:
Function CreateReports()
Dim rpt As Report
Dim ctl As Control
Dim x As Integer
Dim nTop As Long
Dim nPOS As Long
Dim i As Integer
' Create the parent report
Set rpt = CreateReport
'ListDbQrys
' Add the subreport controls
x = 1
nTop = 50
If Qcount = 0 Then Qcount = lblQcount.Caption
'Set rpt.Height = 500 * Qcount
For x = 1 To Qcount
nPOS = DCount("*", QueryArray(x))
Set ctl = CreateReportControl(rpt.Name, acSubform, acDetail, rpt.Name, x, 15, nTop, 5000, nPOS * 15)
' set subreport properties here
ctl.SourceObject = "Query." & QueryArray(x) 'sets source report to the current query in the loop
ctl.StatusBarText = Chr(34) & ctl.SourceObject & Chr(34)
'try to resize the columns of each subreport query
' Dim qdf1 As DAO.QueryDef
' Dim fld1 As DAO.Field
'
' Set qdf1 = CurrentDb.QueryDefs(QueryArray(x))
'
' For i = 0 To qdf1.Fields.Count - 1
' Set fld1 = qdf1.Fields(i)
' fld1.CreateProperty "ColumnWidth", dbInteger
' Set fld1 = Nothing
' Next i
'If nPOS < 4 Then nPOS = nPOS + 4
nTop = nTop + (x * 500)
Next
DoEvents
DoCmd.OpenReport rpt.Name, acViewPreview, , , acDialog
'this will restore the report, which is currently minimized in design view.
'DoCmd.OpenReport rpt
Set ctl = Nothing
Set rpt = Nothing
End Function
Whereas this is what I have to export to Word:
(This doesn't like the SQL queries in the "Qtable" section, it throws an error)
Function FindBMark(txtQuery As String)
Dim WordObj As Word.Application
Dim cnxn As ADODB.Connection
Dim rL As ADODB.Recordset
Set cnxn = CurrentProject.Connection
Set rL = New ADODB.Recordset
On Error GoTo err_handle
' Start Microsoft Word and open the document.
Set WordObj = CreateObject("Word.Application")
WordObj.Documents.Open "Y:\Report Template - Test.docx" 'to be made dynamic
With WordObj.ActiveDocument
'.Bookmarks("qtitle").Select
.Bookmarks("qtitle").Range.Text = txtQuery
'add qrytable info to document
'.Bookmarks("qtable").Range.Fields(1).Result.Text = txtQuery
rL.Open txtQuery, cnxn, adOpenForwardOnly, adLockReadOnly, acQuery
If Not rL.EOF Then .Bookmarks("qtable").Range.Fields(1).Result.Text = rL.Fields(txtQuery)
'.Bookmarks("qtable").Select
.Bookmarks("qtable").Range.Fields(1).Result.Text = rL.Fields(txtQuery)
'.Bookmarks("qtotal").Select
.Bookmarks("qtotal").Range.Text = DSum("Mentions", txtQuery) & " Comments"
rL.Close
End With
'Close and save the document.
WordObj.ActiveDocument.Close SaveChanges:=wdSaveChanges
'WordObj.ActiveDocument.Save
' Quit Microsoft Word and release the object variable.
WordObj.Quit
If MsgBox("Task Completed" & vbCrLf & vbCrLf & "Do you want to open the file?", vbYesNo) = vbYes Then _
WordObj.Documents.Open "Y:\Report Template - Test.docx"
Set WordObj = Nothing
Exit Function
err_handle:
MsgBox Err.Number & "-" & Err.Description
WordObj.ActiveDocument.Close SaveChanges:=wdSaveChanges
WordObj.Quit
End Function
Anyone know of a better way of achieving this please?
The number of and values of these queries will be different, so I can't hard code much. It all has to be dynamic.
I am at the point where I can generate the queries easily enough, but the issue is how to present them in a suitable format.
I could export them one at a time to different reports, but it needs to be in a word document format (so the built in RTF exporter won't work).
I'll be exporting the queries directly, as well as strings, so it will need to be able to export the queries directly into Word. I have the following code so far
For creating a report:
Function CreateReports()
Dim rpt As Report
Dim ctl As Control
Dim x As Integer
Dim nTop As Long
Dim nPOS As Long
Dim i As Integer
' Create the parent report
Set rpt = CreateReport
'ListDbQrys
' Add the subreport controls
x = 1
nTop = 50
If Qcount = 0 Then Qcount = lblQcount.Caption
'Set rpt.Height = 500 * Qcount
For x = 1 To Qcount
nPOS = DCount("*", QueryArray(x))
Set ctl = CreateReportControl(rpt.Name, acSubform, acDetail, rpt.Name, x, 15, nTop, 5000, nPOS * 15)
' set subreport properties here
ctl.SourceObject = "Query." & QueryArray(x) 'sets source report to the current query in the loop
ctl.StatusBarText = Chr(34) & ctl.SourceObject & Chr(34)
'try to resize the columns of each subreport query
' Dim qdf1 As DAO.QueryDef
' Dim fld1 As DAO.Field
'
' Set qdf1 = CurrentDb.QueryDefs(QueryArray(x))
'
' For i = 0 To qdf1.Fields.Count - 1
' Set fld1 = qdf1.Fields(i)
' fld1.CreateProperty "ColumnWidth", dbInteger
' Set fld1 = Nothing
' Next i
'If nPOS < 4 Then nPOS = nPOS + 4
nTop = nTop + (x * 500)
Next
DoEvents
DoCmd.OpenReport rpt.Name, acViewPreview, , , acDialog
'this will restore the report, which is currently minimized in design view.
'DoCmd.OpenReport rpt
Set ctl = Nothing
Set rpt = Nothing
End Function
Whereas this is what I have to export to Word:
(This doesn't like the SQL queries in the "Qtable" section, it throws an error)
Function FindBMark(txtQuery As String)
Dim WordObj As Word.Application
Dim cnxn As ADODB.Connection
Dim rL As ADODB.Recordset
Set cnxn = CurrentProject.Connection
Set rL = New ADODB.Recordset
On Error GoTo err_handle
' Start Microsoft Word and open the document.
Set WordObj = CreateObject("Word.Application")
WordObj.Documents.Open "Y:\Report Template - Test.docx" 'to be made dynamic
With WordObj.ActiveDocument
'.Bookmarks("qtitle").Select
.Bookmarks("qtitle").Range.Text = txtQuery
'add qrytable info to document
'.Bookmarks("qtable").Range.Fields(1).Result.Text = txtQuery
rL.Open txtQuery, cnxn, adOpenForwardOnly, adLockReadOnly, acQuery
If Not rL.EOF Then .Bookmarks("qtable").Range.Fields(1).Result.Text = rL.Fields(txtQuery)
'.Bookmarks("qtable").Select
.Bookmarks("qtable").Range.Fields(1).Result.Text = rL.Fields(txtQuery)
'.Bookmarks("qtotal").Select
.Bookmarks("qtotal").Range.Text = DSum("Mentions", txtQuery) & " Comments"
rL.Close
End With
'Close and save the document.
WordObj.ActiveDocument.Close SaveChanges:=wdSaveChanges
'WordObj.ActiveDocument.Save
' Quit Microsoft Word and release the object variable.
WordObj.Quit
If MsgBox("Task Completed" & vbCrLf & vbCrLf & "Do you want to open the file?", vbYesNo) = vbYes Then _
WordObj.Documents.Open "Y:\Report Template - Test.docx"
Set WordObj = Nothing
Exit Function
err_handle:
MsgBox Err.Number & "-" & Err.Description
WordObj.ActiveDocument.Close SaveChanges:=wdSaveChanges
WordObj.Quit
End Function
Anyone know of a better way of achieving this please?