G
Guest
This a VB6 app that uses Access 2000(Just Migrated from
97) for reports.
The fact that two connections cannot be open to the same
database is causing several problems. Most of which have
been overcome. But this last one is causing me some grief.
I need to get the reports recordsource
If the report recordsource has the "AUDITNUMBER" field in
it then I set the filter for that Recordsource. If not,
then dont set the filter. Problem is that I can only find
the recordsource property after I open the Access Db with
Automation. Once I get that i cannot leave the DB open to
check the FieldDefs for the "AUDITNUMBER" field because
Access wont allow that.
This is the code as it is written. Ive been hacking on it
so it probably inst perfect anymore. But basically it
works like this. In Access97. But I need something similar
for 2000
1)Select a report from a VB listbox.
2)Open the report with Automation and get the RecordSource
3)Open the DB with DAO to go through the Definitions
4)Check to see if its a Table or Query
5)Roll through the TableDefs or QueryDefs looking for My
field.
6)If it s there set the filter.
This works in Access 97 because 97 will let you have
multiple connections open to the same Db but Access 2000
will not.
Any insight would be helpful.
Thanks
Malcolm
''''''''
sReport = lstReports.List(lstReports.ListIndex)
appAccess.OpenCurrentDatabase gsReportsWorksheetLocation
& "\Reports.mdb", False
appAccess.DoCmd.OpenReport sReport, acViewDesign
sRecordSource = appAccess.Reports(sReport).RecordSource
'Close the connection
If dbReports Is Nothing Then
'Open the Database back-up
On Error GoTo ReportError
Set dbReports = wrkASIS.OpenDatabase
(gsReportsWorksheetLocation & "\Reports.mdb", False)
End If
If Not sRecordSource = "" Then
'check to see if the recordsource is a table
For i = 0 To dbAudits.TableDefs.Count - 1
If dbAudits.TableDefs(i).Name = sRecordSource Then
bTest = True
Exit For
End If
Next i
bAudNumFieldPresent = False
If bTest = False Then
'must be a querydef
For i = 0 To dbReports.QueryDefs
(sRecordSource).Fields.Count - 1
If InStr(1, UCase(dbReports.QueryDefs
(sRecordSource).Fields(i).Name), "AUDITNUMBER") > 0 Then
bAudNumFieldPresent = True
Exit For
End If
Next i
Else
'it was a table
For i = 0 To dbAudits.TableDefs
(sRecordSource).Fields.Count - 1
If InStr(1, UCase(dbAudits.TableDefs
(sRecordSource).Fields(i).Name), "AUDITNUMBER") > 0 Then
bAudNumFieldPresent = True
Exit For
End If
Next i
End If
'Close the connection
If Not dbReports Is Nothing Then
dbReports.Close
Set dbReports = Nothing
End If
If bAudNumFieldPresent = True Then
If cmbAudits.Columns(0).Text = "" Then
appAccess.Reports(sReport).FilterOn = False
Else
appAccess.Reports(sReport).Filter
= "auditnumber = '" & cmbAudits.Columns(0).Value & "'"
appAccess.Reports(sReport).FilterOn = True
End If
End If
End If
If sType = "PREVIEW" Then
appAccess.DoCmd.OpenReport sReport, acViewPreview
Screen.MousePointer = vbNormal
On Error Resume Next
appAccess.Application.Visible = True
On Error GoTo ERR_ROUTINE
appAccess.DoCmd.Maximize
Else
appAccess.DoCmd.OpenReport sReport, acViewNormal
appAccess.CloseCurrentDatabase
appAccess.Quit acQuitSaveNone
Set appAccess = Nothing
Screen.MousePointer = vbNormal
End If
97) for reports.
The fact that two connections cannot be open to the same
database is causing several problems. Most of which have
been overcome. But this last one is causing me some grief.
I need to get the reports recordsource
If the report recordsource has the "AUDITNUMBER" field in
it then I set the filter for that Recordsource. If not,
then dont set the filter. Problem is that I can only find
the recordsource property after I open the Access Db with
Automation. Once I get that i cannot leave the DB open to
check the FieldDefs for the "AUDITNUMBER" field because
Access wont allow that.
This is the code as it is written. Ive been hacking on it
so it probably inst perfect anymore. But basically it
works like this. In Access97. But I need something similar
for 2000
1)Select a report from a VB listbox.
2)Open the report with Automation and get the RecordSource
3)Open the DB with DAO to go through the Definitions
4)Check to see if its a Table or Query
5)Roll through the TableDefs or QueryDefs looking for My
field.
6)If it s there set the filter.
This works in Access 97 because 97 will let you have
multiple connections open to the same Db but Access 2000
will not.
Any insight would be helpful.
Thanks
Malcolm
''''''''
sReport = lstReports.List(lstReports.ListIndex)
appAccess.OpenCurrentDatabase gsReportsWorksheetLocation
& "\Reports.mdb", False
appAccess.DoCmd.OpenReport sReport, acViewDesign
sRecordSource = appAccess.Reports(sReport).RecordSource
'Close the connection
If dbReports Is Nothing Then
'Open the Database back-up
On Error GoTo ReportError
Set dbReports = wrkASIS.OpenDatabase
(gsReportsWorksheetLocation & "\Reports.mdb", False)
End If
If Not sRecordSource = "" Then
'check to see if the recordsource is a table
For i = 0 To dbAudits.TableDefs.Count - 1
If dbAudits.TableDefs(i).Name = sRecordSource Then
bTest = True
Exit For
End If
Next i
bAudNumFieldPresent = False
If bTest = False Then
'must be a querydef
For i = 0 To dbReports.QueryDefs
(sRecordSource).Fields.Count - 1
If InStr(1, UCase(dbReports.QueryDefs
(sRecordSource).Fields(i).Name), "AUDITNUMBER") > 0 Then
bAudNumFieldPresent = True
Exit For
End If
Next i
Else
'it was a table
For i = 0 To dbAudits.TableDefs
(sRecordSource).Fields.Count - 1
If InStr(1, UCase(dbAudits.TableDefs
(sRecordSource).Fields(i).Name), "AUDITNUMBER") > 0 Then
bAudNumFieldPresent = True
Exit For
End If
Next i
End If
'Close the connection
If Not dbReports Is Nothing Then
dbReports.Close
Set dbReports = Nothing
End If
If bAudNumFieldPresent = True Then
If cmbAudits.Columns(0).Text = "" Then
appAccess.Reports(sReport).FilterOn = False
Else
appAccess.Reports(sReport).Filter
= "auditnumber = '" & cmbAudits.Columns(0).Value & "'"
appAccess.Reports(sReport).FilterOn = True
End If
End If
End If
If sType = "PREVIEW" Then
appAccess.DoCmd.OpenReport sReport, acViewPreview
Screen.MousePointer = vbNormal
On Error Resume Next
appAccess.Application.Visible = True
On Error GoTo ERR_ROUTINE
appAccess.DoCmd.Maximize
Else
appAccess.DoCmd.OpenReport sReport, acViewNormal
appAccess.CloseCurrentDatabase
appAccess.Quit acQuitSaveNone
Set appAccess = Nothing
Screen.MousePointer = vbNormal
End If