Oops Part II of II cont
Public Function ExportReportToFile(strReportName As String, Optional lngRptType As opgRptType, Optional bolOpen As Boolean = False) As Boolean
Dim strReportPath As String
strReportPath = App.Path & "\"
If Not (appAccess Is Nothing) Then
If AccessObjectExists("Report", strReportName) Then
With appAccess
' Output or display in specified format.
Select Case lngRptType
Case XLS
.DoCmd.OutputTo acOutputReport, strReportName, acFormatXLS, _
strReportPath & strReportName & ".xls", bolOpen
Case RTF
.DoCmd.OutputTo acOutputReport, strReportName, acFormatRTF, _
strReportPath & strReportName & ".rtf", bolOpen
Case SNAPSHOT
' Snapshot Viewer must be installed to view snapshot
' output.
.DoCmd.OutputTo acOutputReport, strReportName, acFormatSNP, _
strReportPath & strReportName & ".snp", bolOpen
Case HTML
.DoCmd.OutputTo acOutputReport, strReportName, acFormatHTML, _
strReportPath & strReportName & ".htm", bolOpen
Case Else
.Visible = True
.DoCmd.OpenReport strReportName, acViewPreview
End Select
End With
ExportReportToFile = True
Else
MsgBox strReportName & " could not be found. Please check your database for the report.", vbExclamation & vbOKOnly, "ExportReportToSnap Failure"
ExportReportToFile = False
End If
Else
ExportReportToFile = False
End If
End Function
Public Function CopyBaseReportToTemp(strOldReportName As String, strNewReportName As String) As Boolean
If Not (appAccess Is Nothing) Then
If AccessObjectExists("Report", strOldReportName) Then
appAccess.DoCmd.CopyObject , strNewReportName, acReport, strOldReportName
CopyBaseReportToTemp = True
Else
MsgBox strOldReportName & " could not be found. Please check your database for the report.", vbExclamation & vbOKOnly, "CopyBaseReportToTemp Failure"
CopyBaseReportToTemp = False
End If
Else
CopyBaseReportToTemp = False
End If
End Function
Public Function DeleteReport(strReportName As String) As Boolean
If Not (appAccess Is Nothing) Then
If AccessObjectExists("Report", strReportName) Then
appAccess.DoCmd.DeleteObject acReport, strReportName
DeleteReport = True
Else
MsgBox strReportName & " could not be found. Please check your database for the report.", vbExclamation & vbOKOnly, "DeleteReport Failure"
DeleteReport = False
End If
Else
DeleteReport = False
End If
End Function
Public Function OpenMDBBrowser() As String
Dim FileBrowser As Object
Set FileBrowser = CreateObject("MSComDlg.CommonDialog"
FileBrowser.ShowOpen
OpenMDBBrowser = FileBrowser.FileName
Set FileBrowser = Nothing
End Function
Public Function AccessObjectExists(strObjectType As String, strObjectName) As Boolean
Dim i As Integer
Select Case strObjectType
Case "Table"
AccessObjectExists = False
Case "Form"
AccessObjectExists = False
Case "Report"
appAccess.RefreshDatabaseWindow
For i = 0 To appAccess.CurrentDb.Containers!Reports.Documents.Count - 1
If UCase$(strObjectName) = UCase$(appAccess.CurrentDb.Containers!Reports.Documents(i).Name) Then
AccessObjectExists = True
Exit For
Else
Debug.Print appAccess.CurrentDb.Containers!Reports.Documents(i).Name
End If
Next
Case Else
MsgBox "Object Types: Table, Query, Form, Report.", vbInformation & vbOKOnly, "Valid Object Types"
AccessObjectExists = False
End Select
End Function
Public Function PrintReport(strReportName As String, Optional strFilter As String) As Boolean
If Not (appAccess Is Nothing) Then
If AccessObjectExists("Report", strReportName) Then
With appAccess
' Print the Report acViewNormal-Send to Printer
.DoCmd.OpenReport strReportName, acViewNormal, , strFilter
End With
PrintReport = True
Else
MsgBox strReportName & " could not be found. Please check your database for the report.", vbExclamation & vbOKOnly, "ExportReportToSnap Failure"
PrintReport = False
End If
Else
PrintReport = False
End If
End Function
Public Function GetRandomRptName() As String
Dim strUserName As String
' Initialize the Random Number Generator
Randomize
GetRandomRptName = UserName() & Trim$(CStr(Abs(CLng(Rnd * 32000))))
End Function