Option Compare Database
Option Explicit
Public mlngNumDB2Tables As Long
Public mstrReportTitle As String
Public mstrSQL As String
Private Const mconCurrent As String = "Aktuelle"
Private Const mconDeleted As String = "Gelöschte"
Private Const mconDCs As String = modPublDecl.gconSpace & "Data Collection(s)"
'-------------------------------------------------------------------------------------'
' Prozedur: Form_Load
'
' Beschreibung: Lädt das Formular.
' Setzt den Formulartitel und aktualisiert Beschriftung, Tipp- und
' Statusleistentexte.
' Ist das Formular modPublDecl.gconFrmHM nicht geöffnet, wird eine
' Fehlermeldung angezeigt und der Ladevorgang abgebrochen.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub Form_Load()
On Error GoTo Form_Load_Err
Const conPagePreview As String = "Seitenansicht: "
If modPublic.IsFormOpen(modPublDecl.gconFrmHM) = True Then
If modPublic.GetUserComputerName = False Then
Resume Form_Load_Exit
Else
Call modPublic.GetLoginInfo(False)
Call ErrLogExists
With Me
.Caption = modPublDecl.gconAppTitle & "Berichte und Auswertungen"
With .cboDCWorkGroup
.RowSource = modSQL.QSelDCDLWorkGroup("tblDB2DMUserProfile", _
"tblDB2DMCMFiles")
.Requery
If .ListCount <> 0 Then
.Value = .ItemData(0)
Call cboDCWorkGroup_AfterUpdate
With Me.cmdDB2DMDC
.StatusBarText = conPagePreview & mconCurrent & mconDCs
.ControlTipText = .StatusBarText & _
modPublDecl.gconSpace & modPublDecl.gconAltA
End With
End If
End With
With .cboDLWorkGroup
.RowSource = modSQL.QSelDCDLWorkGroup("tblDB2DMCMDeleteLog", _
"tblDB2DMUserProfile")
.Requery
If .ListCount <> 0 Then
.Value = .ItemData(0)
Call cboDLWorkGroup_AfterUpdate
With Me.cmdDB2DMDL
.StatusBarText = conPagePreview & mconDeleted & mconDCs
.ControlTipText = .StatusBarText & _
modPublDecl.gconSpace & modPublDecl.gconAltG
End With
End If
End With
If Forms(modPublDecl.gconFrmHM).mboolHostLogOnOK = False Then
.cmdDB2DMAT.Enabled = False
.lblDB2DMAT.ForeColor = modPublDecl.gconForeColor
Else
.cmdDB2DMAT.Enabled = True
.lblDB2DMAT.ForeColor = 0
End If
End With
End If
Else
Resume Form_Load_Err
End If
Form_Load_Exit:
Exit Sub
Form_Load_Err:
If Err.Number <> 0 Then
Call modPublic.FormReportNotOpen(True, _
True, _
modPublDecl.gconFrmHM, _
Me.Name)
End If
Resume Form_Load_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: ErrLogExists
'
' Beschreibung: In Abhängigkeit davon, ob Daten vorhanden sind, aktiviert bzw.
' deaktiviert diese Prozedur die Befehlsschaltfläche cmdDB2DMEL
' und ändert die Vordergundfarbe des zugehörigen Bezeichnungsfelds
' lblDB2DMEL.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub ErrLogExists()
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim boolEnabled As Boolean
Dim strControlTippText As String
Dim strStatusBarText As String
Dim lngForeColor As Long
strSQL = modSQL.QSelDelTable("tblDB2TableAttribErrLog", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAO
If .EOF Then
boolEnabled = False
strStatusBarText = vbNullString
strControlTippText = strStatusBarText
lngForeColor = modPublDecl.gconForeColor
Else
boolEnabled = True
strStatusBarText = "Seitenansicht: Log: Table Load: Fehlerhafte " & _
"Übereinstimmungen Tabelle(n) und/oder Attribut(e)"
strControlTippText = strStatusBarText & modPublDecl.gconSpace & modPublDecl.gconAltF
lngForeColor = 0
End If
.Close
With Me
With .cmdDB2DMEL
.Enabled = boolEnabled
.ControlTipText = strControlTippText
.StatusBarText = strStatusBarText
End With
.lblDB2DMEL.ForeColor = lngForeColor
End With
End With
Set dbDAO = Nothing
Set rstDAO = Nothing
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDB2DMDC_Click
'
' Beschreibung: Füllt die Tabelle tblDCTblRepTmp und öffnet den Bericht
' modPublDecl.gconRepCD durch Aufruf der Prozedur modPublic.OpenReport.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDB2DMDC_Click()
With Me
Call PrepareReportInit(.cboDCWorkGroup, _
.cboDCUser, _
"tblDB2DMCMFiles", _
"tblDB2DMCMDCTables", _
"DCID", _
modPublDecl.gconRepDC, _
False)
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboDCWorkGroup_AfterUpdate
'
' Beschreibung: Legt nach Aktualisierung des Steuerelements cboDCWorkGroup die
' Datenherkunft des Steuerelements cboDCUser fest.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cboDCWorkGroup_AfterUpdate()
With Me.cboDCUser
.RowSource = modSQL.QSelDCDLUser(IIf(Me.cboDCWorkGroup.Value = modPublDecl.gconSelectAll, _
"*", _
Me.cboDCWorkGroup.Value), _
"tblDB2DMCMFiles", _
"tblDB2DMUserProfile", _
"tblDB2DMCMFiles")
.Requery
.Value = .ItemData(0)
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDB2DMDL_Click
'
' Beschreibung: Füllt die Tabelle tblDCTblRepTmp und öffnet den Bericht
' modPublDecl.gconRepDL durch Aufruf der Prozedur modPublic.OpenReport.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDB2DMDL_Click()
With Me
Call PrepareReportInit(.cboDLWorkGroup, _
.cboDLUser, _
"tblDB2DMCMDeleteLog", _
"tblDB2DMCMDCTablesDeleted", _
"DelDCID", _
modPublDecl.gconRepDL, _
True)
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboDLWorkGroup_AfterUpdate
'
' Beschreibung: Legt nach Aktualisierung des Steuerelements cboDLWorkGroup die
' Datenherkunft des Steuerelements cboDLUser fest.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cboDLWorkGroup_AfterUpdate()
With Me.cboDLUser
.RowSource = modSQL.QSelDCDLUser(IIf(Me.cboDLWorkGroup.Value = modPublDecl.gconSelectAll, _
"*", _
Me.cboDLWorkGroup.Value), _
"tblDB2DMCMDeleteLog", _
"tblDB2DMCMDeleteLog", _
"tblDB2DMUserProfile")
.Requery
.Value = .ItemData(0)
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: PrepareReportInit
'
' Beschreibung: Bereitet den Bericht strReport vor.
'
' Parameter: ctlControl1
' ctlControl2
' strTable1
' strTable2
' strField
' strReport
' boolDLReport
'-------------------------------------------------------------------------------------'
Private Sub PrepareReportInit(ByVal ctlControl1 As Control, _
ByVal ctlControl2 As Control, _
ByVal strTable1 As String, _
ByVal strTable2 As String, _
ByVal strField As String, _
ByVal strReport As String, _
ByVal boolDLReport As Boolean)
Dim strWorkGroup As String
Dim strUser As String
strWorkGroup = IIf(ctlControl1.Value = modPublDecl.gconSelectAll, _
"*", ctlControl1.Value)
strUser = IIf(ctlControl2.Value = modPublDecl.gconSelectAll, _
"*", ctlControl2.Value)
mstrReportTitle = IIf(boolDLReport = False, mconCurrent, mconDeleted) & _
mconDCs & ": " & _
IIf(strWorkGroup = "*", "Alle Arbeitsgruppen", _
"Arbeitsgruppe " & ctlControl1.Value) & _
" - " & _
IIf(strUser = "*", "Alle" & modPublDecl.gconUsers, _
"Bearbeiter(in) " & ctlControl2.Value)
If boolDLReport = False Then ' Aktuelle Data Collections
mstrSQL = modSQL.QSelHostIdDB2DMFiles(strWorkGroup, _
strUser)
Else ' Gelöschte Data Collections
mstrSQL = modSQL.QSelDB2DMDCMDeleteLog(strWorkGroup, _
strUser)
End If
Call PrepareReport(strTable1, _
strTable2, _
strField, _
strReport)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: PrepareReport
'
' Beschreibung: Erstellt die Tabelle tblDCTblRepTmp und öffnet den Bericht strReport.
'
' Parameter: strMasterTable
' strDetailTable
' strField
' strReport
'-------------------------------------------------------------------------------------'
Private Sub PrepareReport(ByVal strMasterTable As String, _
ByVal strDetailTable As String, _
ByVal strField As String, _
ByVal strReport As String)
Call modPublic.SetStatusBarText(16, _
False, _
0)
If CreatetblDCTblRepTmp(strMasterTable, _
strDetailTable, _
strField) = True Then
Call modPublic.OpenReport(strReport)
Else
SysCmd acSysCmdRemoveMeter
End If
End Sub
'-------------------------------------------------------------------------------------'
' Funktion: CreatetblDCTblRepTmp
'
' Beschreibung: Erstellt die Tabelle tblDCTblRepTmp.
'
' Parameter: strMasterTable
' strDetailTable
' strField
'
' Rückgabe: Ohne
'-------------------------------------------------------------------------------------'
Private Function CreatetblDCTblRepTmp(ByVal strMasterTable As String, _
ByVal strDetailTable As String, _
ByVal strField As String) As Boolean
On Error GoTo CreatetblDCTblRepTmp_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim dbDAOSrc As DAO.Database
Dim rstDAOSrc As DAO.Recordset
Dim dbDAOTmp As DAO.Database
Dim rstDAOTmp As DAO.Recordset
Dim strSQL As String
Dim strDB2Env As String
Dim stfTable As String * 9 ' Leerzeichen nach Tablename
Dim strTableList As String
Dim intPos As Integer
Dim lngDCID As Long
Dim lngNumDB2Tables As Long
strSQL = modSQL.QSelDelTable("tblDCTblRepTmp", _
True)
CurrentDb.Execute strSQL
strSQL = modSQL.QSelTblFldOrderByFld(strMasterTable, _
strField, _
vbNullString)
Set dbDAOSrc = CurrentDb()
Set rstDAOSrc = dbDAOSrc.OpenRecordset(strSQL, _
dbOpenSnapshot)
Do Until rstDAOSrc.EOF
strSQL = modSQL.QSelDCIDDelDCID(strMasterTable, _
strDetailTable, _
strField, _
rstDAOSrc.Fields(0))
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
Set dbDAOTmp = CurrentDb()
Set rstDAOTmp = dbDAOTmp.OpenRecordset("tblDCTblRepTmp", _
dbOpenDynaset)
With rstDAO
If Not .EOF Then
lngDCID = .Fields(0)
intPos = InStr(1, !CreatorName, modPublDecl.gconFullStop)
strDB2Env = Left(!CreatorName, intPos - 1)
Do Until .EOF
lngNumDB2Tables = lngNumDB2Tables + 1
stfTable = Mid(!CreatorName, intPos + 1, Len(!CreatorName))
strTableList = strTableList & stfTable
If lngNumDB2Tables Mod 13 = 0 Then
strTableList = strTableList & vbCrLf
End If
.MoveNext
Loop
With rstDAOTmp
.AddNew
!NTUserID = Trim(Left(modPublDecl.gstrWinUserID, 32))
!DCID = lngDCID
!DB2Env = strDB2Env
!DB2Tables = strTableList
!NumDB2Tables = lngNumDB2Tables
.Update
.Close
End With
End If
.Close
End With
strTableList = vbNullString
lngNumDB2Tables = 0
rstDAOSrc.MoveNext
Loop
CreatetblDCTblRepTmp = True
CreatetblDCTblRepTmp_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Set dbDAOTmp = Nothing
Set rstDAOTmp = Nothing
rstDAOSrc.Close
Set dbDAOSrc = Nothing
Set rstDAOSrc = Nothing
Exit Function
CreatetblDCTblRepTmp_Err:
CreatetblDCTblRepTmp = False
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
"Bericht generieren", _
True)
Resume CreatetblDCTblRepTmp_Exit
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDB2DMAD_Click
'
' Beschreibung: Öffnet den Bericht modPublDecl.gconRepAD durch Aufruf der Prozedur
' modPublic.OpenReport.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDB2DMAD_Click()
Call modPublic.OpenReport(modPublDecl.gconRepAD)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDB2DMAT_Click
'
' Beschreibung: Öffnet den Bericht modPublDecl.gconRepAT durch Aufruf der Prozedur
' modPublic.OpenReport.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDB2DMAT_Click()
Call CreateDB2TablesRepTmp
Call modPublic.OpenReport(modPublDecl.gconRepAT)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: CreateDB2TablesRepTmp
'
' Beschreibung: Erstellt die Datenbasis des Berichts modPublDecl.gconRepAT.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Sub CreateDB2TablesRepTmp()
On Error GoTo CreateDB2TablesRepTmp_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim dbDAOTarget As DAO.Database
Dim rstDAOTarget As DAO.Recordset
Dim strSQL As String
Dim strDB2Env As String
Dim stfDB2Table As String * 9
Dim stfDB2TableTypeProt As String * 7
Dim strTableList As String
Dim lngTableCnt As Long
strSQL = modSQL.QSelDelTable("tblDB2Tables", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
strSQL = modSQL.QSelDelTable("tblDCTblRepTmp", _
True)
CurrentDb.Execute strSQL
strSQL = modSQL.QSelDelTable("tblDCTblRepTmp", _
False)
Set dbDAOTarget = CurrentDb()
Set rstDAOTarget = dbDAOTarget.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAO
.MoveFirst
mlngNumDB2Tables = 0
strDB2Env = !CREATOR
Do Until .EOF
strTableList = vbNullString
lngTableCnt = 0
Do Until strDB2Env <> !CREATOR
stfDB2Table = !Name
stfDB2TableTypeProt = "[" & !Type & modPublDecl.gconSpace & !PROTOCOL & "]"
lngTableCnt = lngTableCnt + 1
strTableList = strTableList & stfDB2Table & stfDB2TableTypeProt
If lngTableCnt Mod 8 = 0 Then
strTableList = strTableList & vbCrLf
End If
.MoveNext
Loop
With rstDAOTarget
.AddNew
!DB2Env = strDB2Env
!DB2Tables = strTableList
!NumDB2Tables = lngTableCnt
mlngNumDB2Tables = mlngNumDB2Tables + lngTableCnt
.Update
End With
strDB2Env = !CREATOR
Loop
.Close
rstDAOTarget.Close
End With
CreateDB2TablesRepTmp_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Set dbDAOTarget = Nothing
Set rstDAOTarget = Nothing
Exit Sub
CreateDB2TablesRepTmp_Err:
Resume CreateDB2TablesRepTmp_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDB2DMUL_Click
'
' Beschreibung: Öffnet den Bericht modPublDecl.gconRepUL durch Aufruf der Prozedur
' modPublic.OpenReport.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDB2DMUL_Click()
Call modPublic.OpenReport(modPublDecl.gconRepUL)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDB2DMLL_Click
'
' Beschreibung: Öffnet den Bericht modPublDecl.gconRepLL durch Aufruf der Prozedur
' modPublic.OpenReport.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDB2DMLL_Click()
Call modPublic.OpenReport(modPublDecl.gconRepLL)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDB2DMCL_Click
'
' Beschreibung: Öffnet den Bericht modPublDecl.gconRepCL durch Aufruf der Prozedur
' modPublic.OpenReport.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDB2DMCL_Click()
Call modPublic.OpenReport(modPublDecl.gconRepCL)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDB2DMRPH_Click
'
' Beschreibung: Öffnet das Formular modPublDecl.gconFrmHI durch Aufruf der Prozedur
' modPublic.OpenForm.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDB2DMRPH_Click()
Call modPublic.OpenForm(modPublDecl.gconFrmHI)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDB2DMEL_Click
'
' Beschreibung: Öffnet den Bericht modPublDecl.gconRepEL durch Aufruf der Prozedur
' modPublic.OpenReport.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDB2DMEL_Click()
Call OpenReport(modPublDecl.gconRepEL)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdClose_Click
'
' Beschreibung: Löscht alle Datensätze der Tabelle tblDCTblRepTmp und ruft die Funktion
' modPublic.CloseForm auf.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdClose_Click()
Dim strSQL As String
strSQL = modSQL.QSelDelTable("tblDCTblRepTmp", _
True)
CurrentDb.Execute strSQL
Call modPublic.CloseForm(Me.Name)
End Sub
