-
- Function EditReportFromQuery(StrSQL As String, Query_name As String, Report_Name As String, Filename As String, Format As String) As Boolean
- ' Edit the report named R_name after having repalce the query Q_name by the StrSQL
- ' if a param is NULL then try to ignore it ... or error
- ' return false if error
-
- '* Variable :
- Dim Q_select As QueryDef ' the querydef that will contains the "select" query (i.e a string)
- Dim query As String ' the "select" query
- Dim Q_name As String ' name of the query in this database
- Dim R_name As String ' name of the report
- Dim query_def As QueryDef
- Dim ook As Boolean
-
- '*Begin Sub
-
- On Error GoTo Erro
- If IsNull(Report_Name) Then
- MsgBox "no report name ...?", vbCritical
- End If
- If IsNull(Query_name) Then
- MsgBox "no query ...?", vbCritical
- EditReportFromQuery = False
- Exit Function
- End If
- R_name = Report_Name
- Q_name = Query_name
- If Not IsNull(StrSQL) Then
- ' create a query with this SQL string
- For Each query_def In CurrentDb.QueryDefs
- If query_def.Name = Q_name Then
- CurrentDb.QueryDefs.Delete (Q_name)
- Exit For
- End If
- Next query_def
- 'creation
- Set Q_select = CurrentDb.CreateQueryDef(Q_name, StrSQL)
- Else
- 'if this querydef existing ?
- ook = False
- For Each query_def In CurrentDb.QueryDefs
- If query_def.Name = Q_name Then
- ook = True
- Exit For
- End If
- Next query_def
- If ook = False Then
- MsgBox "no query ...?", vbCritical
- EditReportFromQuery = False
- Exit Function
- End If
- End If
-
- 'open the query as a table
- DoCmd.OpenQuery Q_name, acViewNormal
- 'open the correponding report
- DoCmd.OpenReport R_name, acViewPreview
- 'output to a txt file
- If Not IsNull(Filename) And Filename <> "NILL" Then
- Select Case Format
- Case "HTML"
- DoCmd.OutputTo acOutputReport, R_name, acFormatHTML, Filename, True
- Case "RTF"
- DoCmd.OutputTo acOutputReport, R_name, acFormatRTF, Filename, True
- Case "TXT"
- DoCmd.OutputTo acOutputReport, R_name, acFormatTXT, Filename, True
- Case "XLS"
- DoCmd.OutputTo acOutputReport, R_name, acFormatXLS, Filename, True
- End Select
- End If
-
- EditReportFromQuery = True
- Exit Function
-
- Erro:
- If Err.Number <> 2501 Then
- EditReportFromQuery = False
- MsgBox "EditReportFromQuery : " & Err.Description, vbCritical, Err.Number
- DoCmd.Close
- End If
- End Function
-
Function EditReportFromQuery(StrSQL As String, Query_name As String, Report_Name As String, Filename As String, Format As String) As Boolean
' Edit the report named R_name after having repalce the query Q_name by the StrSQL
' if a param is NULL then try to ignore it ... or error
' return false if error
'* Variable :
Dim Q_select As QueryDef ' the querydef that will contains the "select" query (i.e a string)
Dim query As String ' the "select" query
Dim Q_name As String ' name of the query in this database
Dim R_name As String ' name of the report
Dim query_def As QueryDef
Dim ook As Boolean
'*Begin Sub
On Error GoTo Erro
If IsNull(Report_Name) Then
MsgBox "no report name ...?", vbCritical
End If
If IsNull(Query_name) Then
MsgBox "no query ...?", vbCritical
EditReportFromQuery = False
Exit Function
End If
R_name = Report_Name
Q_name = Query_name
If Not IsNull(StrSQL) Then
' create a query with this SQL string
For Each query_def In CurrentDb.QueryDefs
If query_def.Name = Q_name Then
CurrentDb.QueryDefs.Delete (Q_name)
Exit For
End If
Next query_def
'creation
Set Q_select = CurrentDb.CreateQueryDef(Q_name, StrSQL)
Else
'if this querydef existing ?
ook = False
For Each query_def In CurrentDb.QueryDefs
If query_def.Name = Q_name Then
ook = True
Exit For
End If
Next query_def
If ook = False Then
MsgBox "no query ...?", vbCritical
EditReportFromQuery = False
Exit Function
End If
End If
'open the query as a table
DoCmd.OpenQuery Q_name, acViewNormal
'open the correponding report
DoCmd.OpenReport R_name, acViewPreview
'output to a txt file
If Not IsNull(Filename) And Filename <> "NILL" Then
Select Case Format
Case "HTML"
DoCmd.OutputTo acOutputReport, R_name, acFormatHTML, Filename, True
Case "RTF"
DoCmd.OutputTo acOutputReport, R_name, acFormatRTF, Filename, True
Case "TXT"
DoCmd.OutputTo acOutputReport, R_name, acFormatTXT, Filename, True
Case "XLS"
DoCmd.OutputTo acOutputReport, R_name, acFormatXLS, Filename, True
End Select
End If
EditReportFromQuery = True
Exit Function
Erro:
If Err.Number <> 2501 Then
EditReportFromQuery = False
MsgBox "EditReportFromQuery : " & Err.Description, vbCritical, Err.Number
DoCmd.Close
End If
End Function