Private Sub cmdExecute_Click()
Dim strOrderBy As String
Dim strWhere As String
Dim strfrom As String
Dim strSelect As String
Dim strSQL As String
Dim ctl As Control
Dim memjoin As Boolean
Dim lngReturn As Long
Set objaccess = GetObject(strReportPath, "Access.Application")
Set rpt = objaccess.CreateReport
objaccess.DoCmd.RunCommand acCmdReportHdrFtr
Set mdl = rpt.Module
BuildReport (strSQL)
End Sub
Private Function BuildReport(strSQL As String)
Dim Response As Integer
Dim fichier As String
TempReport (strSQL)
' Print the report without showing it in preview mode.
Response = MsgBox("Do you wish to save the Report?", vbCritical + vbYesNo, "Save Report!")
If Response = vbYes Then
fichier = InputBox("Enter the report name : ", "Save Report", strReportName)
objaccess.DoCmd.Close acReport, strReportName, acSaveYes
If Not IsBlank(fichier) Then
objaccess.DoCmd.Rename fichier, acReport, strReportName
strReportName = fichier
End If
Set rpt = Nothing
objaccess.DoCmd.Quit acExit
Set objaccess = Nothing
OpenForeignReport strReportName, acPreview
Else
objaccess.DoCmd.Close acReport, strReportName, acSaveNo
objaccess.CloseCurrentDatabase
objaccess.DoCmd.Quit
CloseAllConn
End If
CleanSelection
End Function
Private Sub TempReport(strSQL As String)
Dim tClt As Control
Dim strField As String
Dim strTable As String
rpt.Visible = False
' Expose the report header.
rpt.Section(acHeader).Height = 1440 * 0.75
fMakeImage acHeader
fMakeMod (strSQL)
End Sub
Public Sub fMakeMod(strSQL)
Dim strCode As String
Dim wsp As Workspace
Dim db As Database
intLineCount = mdl.CountOfLines
lngReturn = mdl.CreateEventProc("Close", "Report")
mdl.Application.Modules.Application.Visible = False
strCode = "Docmd.DeleteObject acquery, me.name" & vbCrLf
strCode = strCode & "CloseAllAccess" & vbCrLf
strCode = strCode & "Docmd.Quit "
mdl.InsertLines lngReturn + 1, strCode
lngReturn = mdl.CreateEventProc("NoData", "Report")
strCode = "msgbox ""There is no data for this report"",vbCritical + vbOKOnly, ""Cupe4400""" & vbCrLf
strCode = strCode & "CloseAllAccess" & vbCrLf
strCode = strCode & "Docmd.Quit "
mdl.InsertLines lngReturn + 1, strCode
lngReturn = mdl.CreateEventProc("Open", "Report")
strSQL = strSQL & ";"
strSQL = Chr(34) & strSQL & Chr(34)
strCode = "iniReportPath" & vbCrLf
strCode = strCode & "CreateSPT Me.Name," & strSQL & " & _ " & vbCrLf
strCode = strCode & """"", ""ODBC;DSN=""& strDSN &"";UID="" & strUID & "";PWD="" & strPWD & "";DATABASE=""& strDB & """ & vbCrLf
strCode = strCode & "Me.RecordSource = Me.name" & vbCrLf
mdl.InsertLines lngReturn + 1, strCode
Set mdl = Nothing
End Sub
Public Sub CloseAllConn()
On Error GoTo CloseAllConn_ErrHandler
objaccess.Quit
Set mdl = Nothing
Set objaccess = Nothing
Exit Sub
CloseAllConn_ErrHandler:
Resume Next
End Sub