' Abmessungen des aktuellen Formulars
Private Me_WPL As modPublDecl.WINDOWPLACEMENT
Private Me_Width As Long
Private Me_Height As Long
' Abmessungen des MDI-Client-Windows
Private MDIC_WPL As modPublDecl.WINDOWPLACEMENT
Private MDIC_Width As Long
Private MDIC_Height As Long
Private mboolSavingKey As Boolean
Private mboolWGDCExist As Boolean
Public mstrWinUserID As String
'-------------------------------------------------------------------------------------'
' Prozedur: Form_Open
'
' Beschreibung: Öffnet das Formular und setzt den Formulartitel.
' Ist das Formular modPublDecl.gconFrmHM nicht geöffnet, wird eine
' Fehlermeldung angezeigt und das Formular nicht geöffnet.
'
' Parameter: Cancel
'-------------------------------------------------------------------------------------'
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Form_Open_Err
Dim boolFormReportNotOpen As Boolean
If modPublic.IsFormOpen(modPublDecl.gconFrmHM) = True Then
Me.Caption = modPublDecl.gconAppTitle & mconFormTitle
modPublDecl.gstrWorkGroup = modPublic.AssignedWorkGroup()
Call ToggleProfileUserCmd(True)
Call modPublic.GetUserComputerName
gboolAllUsers = False
Call UpdFormTitle
Call GetFormScreenInfo
Else
boolFormReportNotOpen = True
Resume Form_Open_Err
End If
Form_Open_Exit:
Exit Sub
Form_Open_Err:
If Err.Number <> 0 And boolFormReportNotOpen = True Then
Call modPublic.FormReportNotOpen(True, _
True, _
modPublDecl.gconFrmHM, _
Me.Name)
End If
Resume Form_Open_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: Form_Load
'
' Beschreibung: Lädt das Formular, legt die Datenherkunft fest und ruft die Prozedur
' ShowUserProfileDCProperties auf.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub Form_Load()
Dim strSQL As String
strSQL = modSQL.QSelUserDCs(modPublDecl.gstrWinUserID)
With Me
.RecordSource = strSQL
Call ShowUserProfileDCProperties(.cmdShowUserDC, _
False, _
False)
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: Form_Current
'
' Beschreibung: Ändert, abhängig von der Anzeige eigener oder aller Data Collections,
' den Formulartitel.
' Aktualisiert das Steuerelement cboTargetTables.
' Legt den Hintergrund der Steuerlemente txtDCNr und txtDCDescription
' auf Transparent fest und setzt den Fokus auf die Befehlsschaltfläche
' cmdClose.
' Ruft die Prozeduren UpdFormTitle und ControlProperties auf.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub Form_Current()
On Error GoTo Form_Current_Err
Dim strSQL As String
With Me
If .CurrentRecord > 0 Then
mstrWinUserID = .txtWinUserID
strSQL = modSQL.QSelDelDB2DMFilesDCTables(CLng(.txtDCID), _
"*", _
False)
With .cboTargetTables
.RowSource = strSQL
.Value = IIf(.ListCount > 0, .ItemData(0), vbNullString)
End With
.txtDCNr.BackStyle = 0 ' Transparent
.txtDCDescription.BackStyle = 0 ' Transparent
.cmdClose.SetFocus
End If
End With
modPublDecl.gstrZielUmgebung = vbNullString
Call UpdFormTitle
Call ControlProperties
Form_Current_Exit:
Exit Sub
Form_Current_Err:
Resume Form_Current_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: Form_Timer
'
' Beschreibung: Ruft, falls mboolSavingKey = True ist, die Prozedur
' modPublic.CloseSelODBCKeyWindow auf.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub Form_Timer()
If mboolSavingKey = True Then
Call modPublic.CloseSelODBCKeyWindow
End If
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: Form_KeyDown
'
' Beschreibung: Überprüft, ob die Tastenkombination 'Alt+Z' oder 'Strg+Z' betätigt
' wurde.
' Zeigt abhängig von der betätigten Tastenkombination nur die Data
' Collections der angemeldeten Bearbeiterin/des angemeldeten Bearbeiters
' oder die Data Collections aller Bearbeiter/innen an.
' Wurde 'Strg+Z' betätigt, wird das Formular modPublDecl.gconFrmSU zur
' Auswahl einer Bearbeiterin/eines Bearbeiters geöffnet.
'
' Parameter: KeyCode
' Shift
'-------------------------------------------------------------------------------------'
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim intAltDown As Integer
Dim intCtrlDown As Integer
intAltDown = (Shift And acAltMask) > 0
intCtrlDown = (Shift And acCtrlMask) > 0
If KeyCode = vbKeyZ Then
If intAltDown = True Then
If gboolAllUsers = False Then
Call cmdShowProfileDC_Click
End If
ElseIf intCtrlDown = True Then
With Me
gboolAllUsers = .cmdShowUserDC.Visible
If gboolAllUsers = False Then
Call ShowUserProfileDCProperties(.cmdShowUserDC, _
True, _
True)
End If
End With
Call modPublic.GetUserComputerName
Call modPublic.OpenForm(modPublDecl.gconFrmSU)
End If
End If
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: ControlProperties
'
' Beschreibung: Eigenschaften der Steuerlemente in Abhängigkeit von
' - Data Collection(s) vorhanden - Ja/Nein
' - Data Collection entladen - Ja/Nein
' - eigene/alle Data Collections anzeigen
' festlegen.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Public Sub ControlProperties()
Dim strDCMessage As String
Dim boolEnabled As Boolean
modPublDecl.gstrWorkGroup = modPublic.AssignedWorkGroup()
With Me
.txtNumTargetTables.Value = Format(.cboTargetTables.ListCount, "0")
With .txtDCNr
.Locked = True
.Enabled = False
End With
With .txtDCDescription
.Locked = True
.Enabled = False
End With
If .CurrentRecord = 0 Then ' Kein Datensatz vorhanden
Call DisableEditCommandButtons
Call EnDisableLoadDCSelectTargetEnv(False, _
vbNullString, _
vbNullString)
Call modPublic.CtlProperties(.cmdDB2DMCMK, _
False, _
vbNullString)
Call DisableArchDelUnl
Call ToggleProfileUserCmd(True)
ElseIf .CurrentRecord > 0 Then ' Datensatz vorhanden
Call modPublic.CtlProperties(.cmdEditDCNr, _
True, _
strDCMessage & _
mconEditDCNrTipp)
Call modPublic.CtlProperties(.cmdEditDCDescription, _
True, _
strDCMessage & _
mconEditDescrTipp)
If modPublic.IsFormOpen(modPublDecl.gconFrmSR) = True Then
Call modPublic.CtlProperties(.cmdSearch, _
False, _
vbNullString)
Else
Call modPublic.CtlProperties(.cmdSearch, _
True, _
mconSearchTipp)
End If
Call modPublic.CtlProperties(.cmdClose, _
True, _
mconCloseFrmTipp)
If .txtEntladen = True Then
.lblInDB2Env.Visible = IIf(IsNull(.txtLadeUmgeb), False, True)
Call modPublic.CtlProperties(.cmdUnloadDC, _
False, _
vbNullString)
Call modPublic.CtlProperties(.cmdDB2DMCMK, _
True, _
"Vor dem Laden der " & mconDataColl & _
modPublDecl.gconSpace & _
"zu löschende(n) Key(s) auswählen " & _
modPublDecl.gconAltY)
Call EnDisableLoadDCSelectTargetEnv(True, _
mconLoadTipp, _
mconSelEnvTipp)
If mstrWinUserID = modPublDecl.gstrWinUserID Then
boolEnabled = True
If .txtLangzeitarchiv = False Then
Call modPublic.CtlProperties(.cmdPermanentArchive, _
True, _
mconLZArchTipp)
Call cmdDeleteProperties(mconDataColl & modPublDecl.gconSpace & _
Format(.txtDCID, _
modPublDecl.gconlngDCIDFmt) & _
" und den zugehörigen Entladebestand " & _
mconDeleteTipp, _
True)
Else
Call PermanentArchiveDeleteProperties
End If
Else
boolEnabled = False
Call modPublic.CtlProperties(.cmdUnloadDC, _
False, _
vbNullString)
Call PermanentArchiveDeleteProperties
End If
Call modPublic.CtlProperties(.cmdAddNewDC, _
boolEnabled, _
vbNullString)
Call modPublic.CtlProperties(.cmdAddRemTables, _
False, _
vbNullString)
ElseIf .txtEntladen = False Then
.lblInDB2Env.Visible = False
Call modPublic.GetUserComputerName
Call modPublic.CtlProperties(.cmdDB2DMCMK, _
False, _
vbNullString)
If mstrWinUserID = modPublDecl.gstrWinUserID Then
strDCMessage = mconDataColl & modPublDecl.gconSpace & _
Format(.txtDCID, modPublDecl.gconlngDCIDFmt) & _
": "
Call modPublic.CtlProperties(.cmdAddRemTables, _
True, _
strDCMessage & _
mconEditDCTipp)
Call EnDisableLoadDCSelectTargetEnv(False, _
vbNullString, _
vbNullString)
If .cboTargetTables.ListCount = 0 Then
Call modPublic.CtlProperties(.cmdUnloadDC, _
False, _
vbNullString)
Else
Call modPublic.CtlProperties(.cmdUnloadDC, _
True, _
Mid(strDCMessage, _
1, _
Len(strDCMessage) - 2) & _
modPublDecl.gconSpace & _
mconUnloadTipp)
End If
Call modPublic.CtlProperties(.cmdPermanentArchive, _
False, _
vbNullString)
Call cmdDeleteProperties(Mid(strDCMessage, _
1, _
Len(strDCMessage) - 2) & _
modPublDecl.gconSpace & _
mconDeleteTipp, _
True)
ElseIf mstrWinUserID <> modPublDecl.gstrWinUserID Then
Call EnDisableLoadDCSelectTargetEnv(False, _
vbNullString, _
vbNullString)
Call modPublic.CtlProperties(.cmdUnloadDC, _
False, _
vbNullString)
Call PermanentArchiveDeleteProperties
Call modPublic.CtlProperties(.cmdAddRemTables, _
False, _
vbNullString)
End If
End If
End If
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdEditDCNr_Click
'
' Beschreibung: Ermöglicht die Änderung der Data Collection Nummer. Die neue Data
' Collection Nummer wird durch Aufruf der Funktion DCDetail
' erfasst.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdEditDCNr_Click()
Call DCDetail(CLng(Me.txtDCID), _
True, _
False)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdEditDCDescription_Click
'
' Beschreibung: Ermöglicht die Änderung der Beschreibung (Description). Die neue
' Data Collection Beschreibung wird durch Aufruf der Funktion DCDetail
' erfasst.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdEditDCDescription_Click()
Call DCDetail(CLng(Me.txtDCID), _
False, _
False)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdAddRemTables_Click
'
' Beschreibung: Öffnet das Formular modPublDecl.gconFrmST.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdAddRemTables_Click()
Call modPublic.OpenForm(modPublDecl.gconFrmST)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdSelectTargetEnv_Click
'
' Beschreibung: Öffnet das Formular modPublDecl.gconFrmSE.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdSelectTargetEnv_Click()
Call modPublic.OpenForm(modPublDecl.gconFrmSE)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDB2DMCMK_Click
'
' Beschreibung: Öffnet das Formular modPublDecl.gconFrmCMK.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDB2DMCMK_Click()
Call modPublic.OpenForm(modPublDecl.gconFrmCMK)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdUnloadDC_Click
'
' Beschreibung: Steuert den Entladevorgang der gewählten Data Collection.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdUnloadDC_Click()
Dim strEntladeumgebung As String
Dim strZielumgebung As String
Dim avntEnvTable As Variant
Dim lngSatzNr As Long
With Me
lngSatzNr = .CurrentRecord
With .cboTargetTables
avntEnvTable = Split(.Column(1), modPublDecl.gconFullStop, -1)
strEntladeumgebung = Trim(avntEnvTable(0))
If Len(modPublDecl.gstrZielUmgebung) <> 0 Then
strZielumgebung = modPublDecl.gstrZielUmgebung
Else
avntEnvTable = Split(.Column(1), modPublDecl.gconFullStop, -1)
strZielumgebung = Trim(avntEnvTable(0))
End If
End With
If modPublic.EnvJobRunning(strZielumgebung, _
modPublDecl.gconUnloadJob) = False Then
Call JobControlInit(modPublDecl.gconUnloadJob, _
strEntladeumgebung, _
strZielumgebung, _
vbNullString, _
False)
.Requery
Call AufSatzPositionieren(lngSatzNr)
End If
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdLoadDC_Click
'
' Beschreibung: Steuert den Ladevorgang der gewählten Data Collection.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdLoadDC_Click()
Dim strQuellumgebung As String
Dim avntEnvTable As Variant
Dim strKommentar As String
Dim intAntwort As Integer
Dim strLadeModus As String
Dim lngNumKeysDelete As Long
Dim strJobType As String
Dim strLoadJobParameter As String
Dim boolDeleteKey As Boolean
Dim boolStartJob As Boolean
Dim lngRecNum As Long
With Me
lngRecNum = .CurrentRecord
With .cboTargetTables
avntEnvTable = Split(.Column(1), modPublDecl.gconFullStop, -1)
strQuellumgebung = Trim(avntEnvTable(0))
If Len(modPublDecl.gstrZielUmgebung) = 0 Then
modPublDecl.gstrZielUmgebung = strQuellumgebung
End If
End With
End With
boolStartJob = True
If modPublic.EnvJobRunning(modPublDecl.gstrZielumgebung, _
modPublDecl.gconLoadJob) = True Then
boolStartJob = False
Else
intAntwort = modPublic.ShowMsgBox("Wie soll der Ladevorgang durchgeführt werden?" & _
vbCrLf & vbCrLf & _
"Ja" & vbTab & "=" & vbTab & _
"REPLACE (Daten ersetzen)" & vbCrLf & _
"Nein" & vbTab & "=" & vbTab & _
"APPEND (Daten anfügen)", _
modPublDecl.gconYNCanDef3QuStyle, _
"Daten ersetzen/anfügen", _
False)
Select Case intAntwort
Case vbYes
boolDeleteKey = False
modPublDecl.gstrLoadJobParameter = modPublDecl.gconLoadReplaceParam
strLadeModus = "REPLACE"
Case vbNo
lngNumKeysDelete = NumKeysDelete()
If lngNumKeysDelete > 0 Then
intAntwort = modPublic.ShowMsgBox(lngNumKeysDelete & " Key(s)" & _
" vor dem Laden in die " & _
modPublDecl.gconDB2 & " Umgebung '" & _
modPublDecl.gstrZielumgebung & "' löschen?", _
modPublDecl.gconYNCanDef1QuStyle, _
" Key(s) löschen", _
False)
If intAntwort = vbYes Then
boolDeleteKey = True
ElseIf intAntwort = vbNo Then
boolDeleteKey = False
ElseIf intAntwort = vbCancel Then
boolStartJob = False
End If
End If
modPublDecl.gstrLoadJobParameter = modPublDecl.gconLoadAppendParam
strLadeModus = "APPEND"
Case vbCancel
boolStartJob = False
End Select
End If
If boolStartJob = True Then
strKommentar = modPublic.InputComment(True, _
Me.txtDCID, _
False, _
vbNullString)
strJobType = modPublDecl.gconLoadJob
Call JobControlInit(strJobType, _
strQuellumgebung, _
modPublDecl.gstrZielumgebung, _
strLadeModus, _
boolDeleteKey, _
strKommentar, _
lngNumKeysDelete)
Call AufSatzPositionieren(lngRecNum)
End If
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdLoadDC_Enter
'
' Beschreibung: Ruft die Prozedur LoadToolTipp auf.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdLoadDC_Enter()
Call LoadToolTipp
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdLoadDC_MouseMove
'
' Beschreibung: Ruft die Prozedur LoadToolTipp auf.
'
' Parameter: Button
' Shift
' X
' Y
'-------------------------------------------------------------------------------------'
Private Sub cmdLoadDC_MouseMove(Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)
Call LoadToolTipp
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdPermanentArchive_Click
'
' Beschreibung: Setzt das Flag Langzeitarchivierung auf True.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdPermanentArchive_Click()
Dim strSQL As String
Dim lngRecNum As Long
With Me
If modPublic.ShowMsgBox("Soll die " & mconDataColl & " ID " & _
Format(.txtDCID, modPublDecl.gconlngDCIDFmt) & _
" zur Langzeitarchivierung vorgesehen werden?" & _
vbCrLf & vbCrLf & _
"Wenn Sie 'Ja' wählen, kann diese " & mconDataColl & _
" nicht mehr gelöscht werden!", _
modPublDecl.gconYNDef2QuestStyle, _
"Langzeitarchivierung", _
False) = vbYes Then
lngRecNum = .CurrentRecord
strSQL = modSQL.QSelDelCorrDCID(CLng(.txtDCID), _
False)
Call modPublic.UpdDefaultValue(False, _
False, _
True, _
strSQL, _
"Langzeitarchivierung")
Painting = False
.Requery
Call AufSatzPositionieren(lngRecNum)
Painting = True
.cmdClose.SetFocus
Call PermanentArchiveDeleteProperties
End If
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdShowProfileDC_Click
'
' Beschreibung: Zeigt alle Data Collections der Arbeitsgruppe, zu welcher die/der
' angemeldete Bearbeiter(in) gehört, an.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdShowProfileDC_Click()
On Error GoTo cmdShowProfileDC_Click_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modPublic.SelUser("tblDB2DMUserProfile", _
modPublDecl.gstrWinUserID)
strSQL = modPublic.SelUser("tblDB2DMUserProfile", _
modPublDecl.gstrWinUserID)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If Not .EOF Then
modPublDecl.gstrWorkGroup = !ProfileGroup
.Close
End If
End With
Set dbDAO = Nothing
Set rstDAO = Nothing
strSQL = modSQL.QSelWGDC()
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If Not .EOF Then
mboolWGDCExist = True
gboolAllUsers = True
Me.RecordSource = strSQL
Call ToggleProfileUserCmd(False)
Else
mboolWGDCExist = False
Call modPublic.ShowMsgBox("Es sind keine" & modPublDecl.gconDataColls & _
"der Arbeitsgruppe '" & modPublDecl.gstrWorkGroup & _
"' vorhanden!", _
modPublDecl.gconOkExcStyle, _
"Keine" & modPublDecl.gconDataColls & "vorhanden", _
True)
End If
.Close
End With
cmdShowProfileDC_Click_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Sub
cmdShowProfileDC_Click_Err:
Resume cmdShowProfileDC_Click_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdShowUserDC_Click
'
' Beschreibung: Zeigt nur die Data Collections der angemeldeten Bearbeiterin/des
' angemeldeten Bearbeiters.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdShowUserDC_Click()
On Error GoTo cmdShowUserDC_Click_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Call modPublic.GetUserComputerName
mstrWinUserID = modPublDecl.gstrWinUserID
gboolAllUsers = False
modPublDecl.gstrWorkGroup = vbNullString
strSQL = modSQL.QSelDistUserDC(mstrWinUserID)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If .EOF Then
Call DisableCommandButtons
Call modPublic.CtlProperties(Me.cmdDeleteDC, _
False, _
vbNullString)
modPublDecl.gstrZielUmgebung = vbNullString
Call UpdFormTitle
End If
.Close
End With
Me.RecordSource = strSQL
Call ToggleProfileUserCmd(True)
cmdShowUserDC_Click_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Sub
cmdShowUserDC_Click_Err:
Resume cmdShowUserDC_Click_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdSearch_Click
'
' Beschreibung: Ruft die Prozedur modPublic.MoveFrmDB2DMCM auf und öffnet das Formular
' modPublDecl.gconFrmSR.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdSearch_Click()
If gboolAllUsers = False Then
Call cmdShowProfileDC_Click
End If
If mboolWGDCExist = True Then
Me.cboTargetTables.SetFocus
Call modPublic.MoveFrmDB2DMCM(False, _
False)
Call modPublic.OpenForm(modPublDecl.gconFrmSR)
End If
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDeleteDC_Click
'
' Beschreibung: Löscht die angezeigte Data Collection:
' - Falls die Data Collection nicht entladen wurde, wird die Data
' Collection innerhalb der Prozedur gelöscht.
' - Falls die Data Collection entladen wurde, wird die Data Collection
' durch Aufruf der Prozedur DeleteSteuerung gelöscht.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDeleteDC_Click()
On Error GoTo cmdDeleteDC_Click_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim lngRecNum As Long
With Me
lngRecNum = .CurrentRecord - 1
If .txtEntladen = True Then
Call DeleteSteuerung
.Requery
If lngRecNum = 0 Then ' Kein Datensatz vorhanden
Call modPublic.CtlProperties(.cmdSearch, _
True, _
mconSearchTipp)
Call modPublic.CtlProperties(.cmdAddNewDC, _
True, _
mconAddDCTipp)
Call ToggleProfileUserCmd(True)
Call ShowUserProfileDCProperties(.cmdShowUserDC, _
False, _
False)
Call modPublic.CtlProperties(.cmdClose, _
True, _
mconCloseFrmTipp)
Else ' Datensatz vorhanden
Call AufSatzPositionieren(lngRecNum)
End If
Else
If modPublic.ShowMsgBox(mconDataColl & " ID " & _
Format(.txtDCID, modPublDecl.gconlngDCIDFmt) & _
" löschen?" & vbCrLf & vbCrLf & _
"Diese Änderung kann nicht rückgängig " & _
"gemacht werden!", _
modPublDecl.gconYNDef2QuestStyle, _
"Vorgang fortsetzen?", _
False) = vbYes Then
Call UpdConfigDCID(.txtDCID, _
False)
AllowEdits = True
strSQL = modSQL.QSelDelCorrTableField("tblDB2DMCMFiles", _
"DCID", _
.txtDCID, _
True, _
True)
CurrentDb.Execute strSQL
AllowEdits = False
End If
.Requery
Call AufSatzPositionieren(lngRecNum)
End If
End With
strSQL = modSQL.QSelDistUserDC(modPublDecl.gstrWinUserID)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If .EOF Then
Call DisableEditCommandButtons
Call EnDisableLoadDCSelectTargetEnv(False, _
vbNullString, _
vbNullString)
Call DisableArchDelUnl
End If
.Close
End With
cmdDeleteDC_Click_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Sub
cmdDeleteDC_Click_Err:
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
mconDataColl & " löschen", _
True)
Resume cmdDeleteDC_Click_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: DeleteSteuerung
'
' Beschreibung: Steuert das Löschen der angezeigten Data Collection.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub DeleteSteuerung()
Dim strZielumgebung As String
Dim avntEnvTable As Variant
avntEnvTable = Split(Me.cboTargetTables.Column(1), modPublDecl.gconFullStop, -1)
strZielumgebung = Trim(avntEnvTable(0))
If modPublic.EnvJobRunning(strZielumgebung, _
modPublDecl.gconDeleteJob) = False Then
Call JobControlInit(modPublDecl.gconDeleteJob, _
strZielumgebung, _
strZielumgebung, _
vbNullString, _
False)
End If
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdAddNewDC_Click
'
' Beschreibung: Anlegen einer neuen Data Collection.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdAddNewDC_Click()
On Error GoTo cmdAddNewDC_Click_Err
Dim dbDAOMaxDCID As DAO.Database
Dim rstDAOMaxDCID As DAO.Recordset
Dim dbDAODB2DMFiles As DAO.Database
Dim rstDAODB2DMFiles As DAO.Recordset
Dim strSQL As String
Dim lngDCID As Long
Dim strDCNr As String
Dim strDescription As String
strSQL = modSQL.QSelDelTable("tblDB2DMConfig", _
False)
Set dbDAOMaxDCID = CurrentDb()
Set rstDAOMaxDCID = dbDAOMaxDCID.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAOMaxDCID
lngDCID = IIf(Not .EOF, !CurrentDCID + 1, 1)
.Close
End With
Set dbDAOMaxDCID = Nothing
Set rstDAOMaxDCID = Nothing
If modPublic.ShowMsgBox("Neue " & mconDataColl & " ID " & _
Format(lngDCID, modPublDecl.gconlngDCIDFmt) & " anlegen?", _
modPublDecl.gconYNDef2QuestStyle, _
"Neue " & mconDataColl, _
False) = vbYes Then
strDCNr = DCDetail(lngDCID, _
True, _
True)
If Len(strDCNr) <> 0 Then
strDescription = DCDetail(lngDCID, _
False, _
True)
If Len(strDescription) <> 0 Then
Call modPublic.UpdTableField("tblDB2DMConfig", _
"CurrentDCID", _
lngDCID, _
False)
Call modPublic.GetLoginInfo(False)
strSQL = modSQL.QSelDelTable("tblDB2DMCMFiles", _
False)
Set dbDAODB2DMFiles = CurrentDb()
Set rstDAODB2DMFiles = dbDAODB2DMFiles.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAODB2DMFiles
.AddNew
!DCID = lngDCID
!NTUserID = Trim(Left(modPublDecl.gstrWinUserID, 32))
!HostID = modPublDecl.gstrHostID
!CompName = Trim(Left(modPublDecl.gstrComputerName, 32))
!CreateDateTime = Now()
!DCNr = strDCNr
!Description = strDescription
!Entladen = False
.Update
.Requery
.Close
End With
Me.Requery
DoCmd.GoToRecord acDataForm, modPublDecl.gconFrmCM, acLast
Call modPublic.ShowMsgBox("Neue " & mconDataColl & " ID " & _
Format(lngDCID, modPublDecl.gconlngDCIDFmt) & _
" angelegt.", _
modPublDecl.gconOkInfStyle, _
"Neue " & mconDataColl & " angelegt", _
False)
Else
Call AddDCAborted(lngDCID)
End If
Else
Call AddDCAborted(lngDCID)
End If
End If
cmdAddNewDC_Click_Exit:
Set dbDAODB2DMFiles = Nothing
Set rstDAODB2DMFiles = Nothing
Exit Sub
cmdAddNewDC_Click_Err:
Call modPublic.ShowMsgBox("Die " & mconDataColl & " ID " & _
Format(lngDCID, modPublDecl.gconlngDCIDFmt) & _
" wird bereits verwendet!", _
modPublDecl.gconOkCritStyle, _
"Vorgang abgebrochen", _
True)
Resume cmdAddNewDC_Click_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdClose_Click
'
' Beschreibung: Schliesst, falls geöffnet, mittels der Funktion modPublic.CloseForm
' das Formular modPublDecl.gconFrmSR und anschliessend das aktuelle
' Formular (Me.Name).
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdClose_Click()
If IsFormOpen(modPublDecl.gconFrmSR) = True Then
Forms(modPublDecl.gconFrmSR).SetFocus
Call modPublic.CloseForm(modPublDecl.gconFrmSR)
End If
Call modPublic.CloseForm(Me.Name)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: JobControlInit
'
' Beschreibung: Ruft die Funktion SetQualifiers (Setzten der Steuerkarteneinträge) auf.
' Ruft die globale Funktion CreateDBFileList zur Erstellung der Tabellen-
' übersicht auf.
' Steuert den LOAD/UNLOAD/DELETE Job.
'
' Parameter: strJobType
' strEntladeumgebung
' strZielumgebung
' strLadeModus
' boolDeleteKey (Optional)
' strKommentar (Optional)
' lngNumKeysDelete (Optional)
'-------------------------------------------------------------------------------------'
Private Sub JobControlInit(ByVal strJobType As String, _
ByVal strEntladeumgebung As String, _
ByVal strZielumgebung As String, _
ByVal strLadeModus As String, _
Optional ByVal boolDeleteKey As Boolean, _
Optional ByVal strKommentar As String, _
Optional ByVal lngNumKeysDelete As Long)
On Error GoTo JobControlInit_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim strDisposition As String
Dim lngRecNum As Long
Dim strLoadUnloadMsg As String
Dim strTargetEnv As String
Dim boolJobOK As Boolean
Dim dateDatumUhrzeit As Date
Dim dateJCLTime As Date
Dim strSubMeldung As String
Dim lngDCID As Long
Dim intNumKeySaved As Integer
Dim boolTblAttrMatchErr As Boolean
Dim boolAllTablesMatchErr As Boolean
Dim boolRecFileErr As Boolean
Dim bytMessageFlag As Byte
Dim intCnt As Integer
modPublDecl.gboolJobActive = True
If modPublic.EnvTablesUpdating(False) = True Then
Call modPublic.DB2InitErrMsg
Else
gintNumTables = Me.cboTargetTables.ListCount
If strJobType = modPublDecl.gconLoadJob Then ' Laden
bytMessageFlag = 2
strLoadUnloadMsg = " aus " & modPublDecl.gconDB2 & " Umgebung " & _
strEntladeumgebung & " in " & modPublDecl.gconDB2 & _
" Umgebung " & strZielumgebung & " laden"
If strLadeModus = "REPLACE" Then
strSubMeldung = "Die Daten werden ersetzt!"
ElseIf strLadeModus = "APPEND" Then
If IsMissing(boolDeleteKey) Then
strSubMeldung = "Die Daten werden angefügt!"
ElseIf Not IsMissing(boolDeleteKey) Then
If boolDeleteKey = True Then
strSubMeldung = lngNumKeysDelete & " Keys werden gelöscht " & _
"und die Daten angefügt!"
End If
End If
End If
strSubMeldung = vbNullString & vbCrLf & vbCrLf & _
strSubMeldung
ElseIf strJobType = modPublDecl.gconUnloadJob Then ' Entladen
bytMessageFlag = 1
strTargetEnv = strZielumgebung
strLoadUnloadMsg = " (Umgebung " & strZielumgebung & ")" & _
" entladen"
strSubMeldung = vbNullString
ElseIf strJobType = modPublDecl.gconDeleteJob Then ' Löschen
bytMessageFlag = 3
strLoadUnloadMsg = " und den zugehörigen Entladebestand löschen"
strSubMeldung = vbNullString & vbCrLf & vbCrLf & _
"Diese Änderung kann nicht rückgängig gemacht werden!"
End If
With Me
If modPublic.ShowMsgBox(mconDataColl & " ID " & _
Format(.txtDCID, modPublDecl.gconlngDCIDFmt) & _
strLoadUnloadMsg & "?" & strSubMeldung, _
modPublDecl.gconYNDef2QuestStyle, _
"Vorgang fortsetzen?", _
False) = vbYes Then
If modPublic.DB2EnvAvailable(strZielumgebung) = True Then
Select Case strJobType
Case modPublDecl.gconLoadJob, _
modPublDecl.gconUnloadJob, _
modPublDecl.gconDeleteJob
Call modPublic.SetStatusBarText(bytMessageFlag, _
False, _
0)
Call modPublDecl.Sleep(modPublDecl.gconSleep * 4)
End Select
lngRecNum = .CurrentRecord
For intCnt = 1 To 2
If intCnt = 1 _
And SetQualifiers(strEntladeumgebung, _
.txtDCID, _
modPublDecl.gstrDB2SourceQualifier) = False Then
Resume JobControlInit_Exit
End If
If intCnt = 2 _
And SetQualifiers(strZielumgebung, _
.txtDCID, _
modPublDecl.gstrDB2TargetQualifier) = False Then
Resume JobControlInit_Exit
End If
Next intCnt
If strJobType = modPublDecl.gconUnloadJob _
Or strJobType = modPublDecl.gconDeleteJob Then
strSQL = modSQL.QSelDB2DMFilesTablesDCID(CLng(.txtDCID))
If modPublic.CreateDBFileList(strSQL) = False Then
Resume JobControlInit_Exit
End If
End If
Call EnDisableCmdButtons(False)
strDisposition = modPublic.SetDisposition(strJobType)
boolJobOK = modPublic.JobControl(dateJCLTime, _
strEntladeumgebung, _
strZielumgebung, _
modPublDecl.gstrDB2SourceQualifier, _
modPublDecl.gstrDB2TargetQualifier, _
modPublDecl.gstrDataSet, _
strJobType, _
strDisposition, _
boolTblAttrMatchErr, _
boolRecFileErr, _
boolDeleteKey, _
CLng(.txtDCID))
dateDatumUhrzeit = Now()
lngDCID = .txtDCID
strSQL = modSQL.QSelDelCorrDCID(CLng(.txtDCID), _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenDynaset)
SysCmd acSysCmdRemoveMeter
If strJobType = modPublDecl.gconUnloadJob Then ' Entladen
If boolJobOK = True Then
Call modPublic.SetStatusBarText(4, _
False, _
0) ' Key sichern
.TimerInterval = 10 ' Zeitgeberintervall 1/100 Sekunde
mboolSavingKey = True
With rstDAO
.Edit
!Entladen = True
!EntladeDateTime = dateDatumUhrzeit
If SaveKeyControl(modPublDecl.gstrHostID, _
modPublDecl.gstrHostPwd, _
lngDCID, _
strEntladeumgebung) = True Then
intNumKeySaved = NumKeysSaved()
If intNumKeySaved > 0 Then
!KeySaved = True
End If
End If
.Update
.Close
End With
.TimerInterval = 0 ' Zeitgeberintervall aus
mboolSavingKey = False
Call AppendUnloadLog(dateDatumUhrzeit, _
dateJCLTime, _
lngDCID, _
boolJobOK)
End If
ElseIf strJobType = modPublDecl.gconLoadJob Then ' Laden
If boolTblAttrMatchErr = False And boolJobOK = True Then
With rstDAO
.Edit
!LadeDateTime = dateDatumUhrzeit
!LadeUmgebung = strZielumgebung
.Update
.Close
End With
End If
If boolTblAttrMatchErr = False And boolRecFileErr = False Then
Call AppendLoadLog(dateDatumUhrzeit, _
dateJCLTime, _
lngDCID, _
strZielumgebung, _
boolJobOK, _
strKommentar, _
boolDeleteKey, _
strLadeModus)
End If
ElseIf strJobType = modPublDecl.gconDeleteJob Then ' Data Collection löschen
If boolJobOK = True Then
Call modPublic.SetStatusBarText(13, _
False, _
0) ' DCID und Key(s) löschen
Call modPublDecl.Sleep(modPublDecl.gconSleep * 4)
Call UpdConfigDCID(lngDCID, _
True)
Call AppendDeleteLog(dateDatumUhrzeit, _
dateJCLTime, _
lngDCID)
lngRecNum = lngRecNum - 1
.Painting = False
.Requery
.Painting = True
End If
End If
Call EnDisableCmdButtons(True)
.Requery
Call AufSatzPositionieren(lngRecNum)
If boolJobOK = True Then
Call modPublic.CtlProperties(.cmdPermanentArchive, _
True, _
mconLZArchTipp)
End If
End If
End If
End With
End If
JobControlInit_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
SysCmd acSysCmdRemoveMeter
modPublDecl.gboolJobActive = False
Exit Sub
JobControlInit_Err:
Resume JobControlInit_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: SetQualifiers
'
' Beschreibung: Setzt die Steuerkarteneinträge der DB2 Quell- oder Zielumgebung.
'
' Parameter: strDB2Env
' strDCID
' rstrDB2Qualifier
'
' Rückgabe: rstrDB2Qualifier
' SetQualifiers
'-------------------------------------------------------------------------------------'
Private Function SetQualifiers(ByVal strDB2Env As String, _
ByVal strDCID As String, _
ByRef rstrDB2Qualifier As String) As Boolean
On Error GoTo SetQualifiers_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim intCnt As Integer
strSQL = modSQL.QSelDelCorrTableField("tblDB2EnvCfg", _
"DB2Env", _
strDB2Env, _
False, _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If Not .EOF Then
rstrDB2Qualifier = !Qualifier
modPublDecl.gstrDataSet = !DCLead & Format((Me.txtDCID), _
modPublDecl.gconlngDCIDFmt)
Else
Resume SetQualifiers_Err
End If
.Close
SetQualifiers = True
End With
SetQualifiers_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Function
SetQualifiers_Err:
SetQualifiers = False
Call modPublic.ShowMsgBox("Die " & modPublDecl.gconDB2 & " Quellumgebung '" & _
strDB2Env & "' steht nicht zur Verfügung.", _
modPublDecl.gconOkExcStyle, _
"Qualifier ermitteln", _
True)
Resume SetQualifiers_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: DCDetail
'
' Beschreibung: Eingabe der Data Collection Nummer oder Data Collection Beschreibung,
' gesteuert durch boolIsDCNummer.
'
' Parameter: lngDCID
' boolIsDCNummer
' boolIsNewDC
'
' Rückgabe: DCDetail
'-------------------------------------------------------------------------------------'
Private Function DCDetail(ByVal lngDCID As Long, _
ByVal boolIsDCNummer As Boolean, _
ByVal boolIsNewDC As Boolean) As String
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim strDCDetail As String
Dim boolDCDetailOK As Boolean
Dim intLen As Integer
Dim lngSatzNr As Long
strDCDetail = IIf(boolIsDCNummer = True, "Nummer", "Beschreibung")
intLen = IIf(boolIsDCNummer = True, 10, 100)
With Me
lngSatzNr = .CurrentRecord
If boolIsNewDC = True Then
DCDetail = vbNullString
Else
DCDetail = IIf(boolIsDCNummer = True, .txtDCNr, .txtDCDescription)
End If
End With
Do
DCDetail = InputBox(strDCDetail & " der " & mconDataColl & _
modPublDecl.gconSpace & _
Format(lngDCID, modPublDecl.gconlngDCIDFmt) & _
" eingeben:", _
modPublDecl.gconAppTitle & _
mconDataColl & modPublDecl.gconSpace & strDCDetail, _
DCDetail)
If Len(Trim(DCDetail)) > intLen Then
boolDCDetailOK = False
Call modPublic.ShowMsgBox(strDCDetail & " der " & mconDataColl & " " & _
"darf (einschl. Leer- und Sonderzeichen) " & _
"nicht länger als " & intLen & " Stellen sein.", _
modPublDecl.gconOkExcStyle, _
strDCDetail & " zu lang", _
True)
ElseIf Len(Trim(DCDetail)) > 0 Then
boolDCDetailOK = True
If boolIsNewDC = False Then
strSQL = modSQL.QSelDelCorrDCID(lngDCID, _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAO
.MoveFirst
.Edit
If boolIsDCNummer = True Then
!DCNr = DCDetail
Else
!Description = DCDetail
End If
.Update
.Requery
.Close
End With
Set dbDAO = Nothing
Set rstDAO = Nothing
Me.Requery
Call AufSatzPositionieren(lngSatzNr)
End If
ElseIf Len(Trim(DCDetail)) = 0 Then ' Abbruch
boolDCDetailOK = True
End If
Loop Until boolDCDetailOK
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: AddDCAborted
'
' Beschreibung: Meldung, falls das Anlegen einer neuen Data Collection abgebrochen wurde.
'
' Parameter: lngDCID
'-------------------------------------------------------------------------------------'
Private Sub AddDCAborted(ByVal lngDCID As Long)
Call modPublic.ShowMsgBox("Data Collection ID " & Format(lngDCID, _
modPublDecl.gconlngDCIDFmt) & " wurde nicht angelegt!", _
modPublDecl.gconOkInfStyle, _
mconDataColl & " anlegen", _
False)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: LoadToolTipp
'
' Beschreibung: Aktualisiert den Steuerelement Tipp Text des Steuerelements cmdLoadDC.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub LoadToolTipp()
On Error GoTo LoadToolTipp_Err
Dim strEnvironment As String
Dim avntEnvTable As Variant
Dim strTipp As String
With Me
If Len(modPublDecl.gstrZielUmgebung) = 0 Then
With .cboTargetTables
If Len(.Column(1)) <> 0 Then
avntEnvTable = Split(.Column(1), modPublDecl.gconFullStop, -1)
strEnvironment = Trim(avntEnvTable(0))
End If
End With
Else
strEnvironment = modPublDecl.gstrZielUmgebung
End If
strTipp = mconDataColl & modPublDecl.gconSpace & _
Format(.txtDCID, modPublDecl.gconlngDCIDFmt) & " in die " & _
modPublDecl.gconDB2 & " Umgebung " & strEnvironment & " laden " & _
modPublDecl.gconAltL
Call modPublic.CtlProperties(.cmdLoadDC, _
True, _
strTipp)
End With
LoadToolTipp_Exit:
Exit Sub
LoadToolTipp_Err:
Resume LoadToolTipp_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: AppendLoadLog
'
' Beschreibung: Load Log Eintrag hinzufügen.
'
' Beschreibung: Datum und Uhrzeit des Ladens einer Data Collection protokollieren.
'
' Parameter: dateLadeDateTime
' dateJCLTime
' lngDCID
' strDB2Env
' boolLadenOK
' strKommentar
' boolDeleteKey
' strLadeModus
'-------------------------------------------------------------------------------------'
Private Sub AppendLoadLog(ByVal dateLadeDateTime As Date, _
ByVal dateJCLTime As Date, _
ByVal lngDCID As Long, _
ByVal strDB2Env As String, _
ByVal boolLadenOK As Boolean, _
ByVal strKommentar As String, _
ByVal boolDeleteKey As Boolean, _
ByVal strLadeModus As String)
On Error GoTo AppendLoadLog_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelDelTable("tblDB2DMCMLoadLog", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAO
.AddNew
!DCID = lngDCID
!LadeUmgebung = strDB2Env
!LadeDateTime = dateLadeDateTime
!JCLTime = dateJCLTime
!NTUserID = Trim(Left(modPublDecl.gstrWinUserID, 32))
!LadenOK = boolLadenOK
!LadeModus = strLadeModus
If boolDeleteKey = True Then
boolDeleteKey = IIf(boolLadenOK = True, True, False)
End If
!KeyDeleted = boolDeleteKey
!Kommentar = strKommentar
.Update
.Close
End With
AppendLoadLog_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Sub
AppendLoadLog_Err:
Call modPublic.LogErrMsg("Load")
Resume AppendLoadLog_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: AppendUnloadLog
'
' Beschreibung: Datum und Uhrzeit des Entladens einer Data Collection protokollieren.
'
' Parameter: dateLadeDateTime
' dateJCLTime
' lngDCID
' boolEntladenOK
'-------------------------------------------------------------------------------------'
Private Sub AppendUnloadLog(ByVal dateLadeDateTime As Date, _
ByVal dateJCLTime As Date, _
ByVal lngDCID As Long, _
ByVal boolEntladenOK As Boolean)
On Error GoTo AppendUnloadLog_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelDelTable("tblDB2DMCMUnloadLog", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAO
.AddNew
!DCID = lngDCID
!EntladeDateTime = dateLadeDateTime
!JCLTime = dateJCLTime
!NTUserID = Trim(Left(modPublDecl.gstrWinUserID, 32))
!EntladenOK = boolEntladenOK
.Update
.Close
End With
AppendUnloadLog_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Sub
AppendUnloadLog_Err:
Call modPublic.LogErrMsg("Unload")
Resume AppendUnloadLog_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: AppendDeleteLog
'
' Beschreibung: Datum und Uhrzeit der Löschung einer entladenen Data Collection
' protokollieren.
' Gelöschte Data Collection aus der Tabelle rstDAODB2DMFiles löschen und
' in die Tabelle rstDAODB2DMFilesDel schreiben.
' Data Collection Tabellen in der Tabelle tblDB2DMCMDCTablesDeleted
' sichern.
' Data Collection aus der DC Tabelle tblDB2DMCMFiles löschen.
'
' Parameter: dateDatumUhrzeit
' dateJCLTime
' lngDCID
'-------------------------------------------------------------------------------------'
Private Sub AppendDeleteLog(ByVal dateDatumUhrzeit As Date, _
ByVal dateJCLTime As Date, _
ByVal lngDCID As Long)
On Error GoTo AppendDeleteLog_Err
Dim dbDAODB2DMFiles As DAO.Database
Dim rstDAODB2DMFiles As DAO.Recordset
Dim dbDAODB2DMFilesDel As DAO.Database
Dim rstDAODB2DMFilesDel As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelDelCorrDCID(lngDCID, _
False)
Set dbDAODB2DMFiles = CurrentDb()
Set rstDAODB2DMFiles = dbDAODB2DMFiles.OpenRecordset(strSQL, _
dbOpenDynaset)
strSQL = modSQL.QSelDelTable("tblDB2DMCMDeleteLog", _
False)
Set dbDAODB2DMFilesDel = CurrentDb()
Set rstDAODB2DMFilesDel = dbDAODB2DMFilesDel.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAODB2DMFilesDel
rstDAODB2DMFiles.MoveFirst
.AddNew
!DelDCID = rstDAODB2DMFiles!DCID
!NTUserID = rstDAODB2DMFiles!NTUserID
!HostID = rstDAODB2DMFiles!HostID
!CompName = rstDAODB2DMFiles!CompName
!CreateDateTime = rstDAODB2DMFiles!CreateDateTime
!DCNr = rstDAODB2DMFiles!DCNr
!Description = rstDAODB2DMFiles!Description
!Entladen = rstDAODB2DMFiles!Entladen
!DCUmgebung = rstDAODB2DMFiles!DCUmgebung
!EntladeDateTime = rstDAODB2DMFiles!EntladeDateTime
!LadeDateTime = rstDAODB2DMFiles!LadeDateTime
!LoeschDateTime = dateDatumUhrzeit
!JCLTime = dateJCLTime
.Update
.Close
rstDAODB2DMFiles.Close
End With
strSQL = modSQL.QInsDCTablesDeleted(lngDCID)
CurrentDb.Execute strSQL
strSQL = modSQL.QSelDelCorrDCID(lngDCID, _
True)
CurrentDb.Execute strSQL
AppendDeleteLog_Exit:
Set dbDAODB2DMFiles = Nothing
Set rstDAODB2DMFiles = Nothing
Set dbDAODB2DMFilesDel = Nothing
Set rstDAODB2DMFilesDel = Nothing
Exit Sub
AppendDeleteLog_Err:
Call modPublic.LogErrMsg("Delete")
Resume AppendDeleteLog_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: UpdFormTitle
'
' Beschreibung: Aktualisiert den Formulartitel.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub UpdFormTitle()
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
If Len(mstrWinUserID) = 0 Then
strSQL = modPublic.SelUser("tblDB2DMLogonInfo", _
modPublDecl.gstrWinUserID)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If Not .EOF Then
.MoveFirst
mstrWinUserID = !NTUserID
End If
.Close
End With
Set dbDAO = Nothing
Set rstDAO = Nothing
End If
modPublDecl.gstrWorkGroup = modPublic.AssignedWorkGroup()
Me.Caption = modPublDecl.gconAppTitle & mconFormTitle & " [Arbeitsgruppe: " & _
Trim(modPublDecl.gstrWorkGroup) & " | Bearbeiter(in): " & _
mstrWinUserID & "]" & _
IIf(gboolAllUsers = True And mstrWinUserID <> modPublDecl.gstrWinUserID, _
" *", _
vbNullString)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: UpdConfigDCID
'
' Beschreibung: Vermindert, falls das Feld CurrentDCID gleich dem Inhalt der Variablen
' lngDCID ist und eine entladene Data Collection mit gleicher ID nicht
' gelöscht wurde, den im Feld CurrentDCID der Tabelle tblDB2DMConfig
' gespeicherten Wert um 1.
'
' Parameter: lngDCID
' boolEntladen
'-------------------------------------------------------------------------------------'
Private Sub UpdConfigDCID(ByVal lngDCID As Long, _
ByVal boolEntladen As Boolean)
Dim dbDAODelLog As DAO.Database
Dim rstDAODelLog As DAO.Recordset
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelDeletedDCID(lngDCID)
Set dbDAODelLog = CurrentDb()
Set rstDAODelLog = dbDAODelLog.OpenRecordset(strSQL, _
dbOpenDynaset)
If rstDAODelLog.EOF = True Then
If boolEntladen = False Then
strSQL = modSQL.QSelDelTable("tblDB2DMConfig", _
False)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAO
If Not .EOF Then
.MoveFirst
If !CurrentDCID = lngDCID Then
.Edit
!CurrentDCID = !CurrentDCID - 1
.Update
End If
End If
.Close
End With
End If
End If
rstDAODelLog.Close
Set dbDAO = Nothing
Set rstDAO = Nothing
Set dbDAODelLog = Nothing
Set rstDAODelLog = Nothing
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: EnDisableCmdButtons
'
' Beschreibung: Aktiviert/deaktiviert Befehlsschaltflächen.
'
' Parameter: boolCtlEnabled
'-------------------------------------------------------------------------------------'
Private Sub EnDisableCmdButtons(ByVal boolCtlEnabled As Boolean)
Dim ctlControl As Control
With Me
.cboTargetTables.SetFocus
For Each ctlControl In .Controls
With ctlControl
If .ControlType = acCommandButton Then
.Enabled = boolCtlEnabled
End If
End With
Next ctlControl
NavigationButtons = boolCtlEnabled
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: AufSatzPositionieren
'
' Beschreibung: Positioniert auf den Datensatz mit der Satznummer lngRecNum.
'
' Parameter: lngRecNum
'-------------------------------------------------------------------------------------'
Private Sub AufSatzPositionieren(ByVal lngRecNum As Long)
If lngRecNum >= 1 Then
With Me
.Painting = False
DoCmd.GoToRecord acDataForm, modPublDecl.gconFrmCM, acGoTo, lngRecNum
.Painting = True
End With
End If
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: DisableEditCommandButtons
'
' Beschreibung: Schaltflächen zur Bearbeitung der Data Collection deaktivieren.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub DisableEditCommandButtons()
With Me
Call modPublic.CtlProperties(.cmdEditDCNr, _
False, _
vbNullString)
Call modPublic.CtlProperties(.cmdEditDCDescription, _
False, _
vbNullString)
Call modPublic.CtlProperties(.cmdAddRemTables, _
False, _
vbNullString)
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: DisableArchDelUnl
'
' Beschreibung: Schaltflächen cmdUnloadDC, cmdDB2DMCMK, cmdPermanentArchive und
' cmdDeleteDC deaktivieren.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub DisableArchDelUnl()
With Me
Call modPublic.CtlProperties(.cmdUnloadDC, _
False, _
vbNullString)
Call modPublic.CtlProperties(.cmdDB2DMCMK, _
False, _
vbNullString)
Call modPublic.CtlProperties(.cmdPermanentArchive, _
False, _
vbNullString)
Call cmdDeleteProperties(vbNullString, _
False)
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: PermanentArchiveDeleteProperties
'
' Beschreibung: Schaltflächen cmdPermanentArchive und cmdDeleteDC durch Unterprogramm-
' aufruf in Abhängigkeit von Administrationsmodus aktivieren/deaktivieren.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub PermanentArchiveDeleteProperties()
With Forms(modPublDecl.gconFrmHM)
Call modPublic.CtlProperties(Me.cmdPermanentArchive, _
.mboolIsAdmin, _
vbNullString)
Call cmdDeleteProperties(vbNullString, _
.mboolIsAdmin)
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDeleteProperties
'
' Beschreibung: Schaltfläche cmdDeleteDC aktivieren/deaktivieren und den Steuerelement
' Tipp Text festlegen.
'
' Parameter: strTippText
' boolEnabled
'-------------------------------------------------------------------------------------'
Private Sub cmdDeleteProperties(ByVal strTippText As String, _
ByVal boolEnabled As Boolean)
Call modPublic.CtlProperties(Me.cmdDeleteDC, _
boolEnabled, _
strTippText)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: DisableCommandButtons
'
' Beschreibung: Alle Befehlsschaltflächen, mit Ausnahme der Befehlsschaltflächen
' cmdShowProfileDC, cmdAddNewDC, cmdSearch, cmdDeleteDC und cmdClose,
' deaktivieren.
' Wird u.a. beim Öffnen des Formulars ausgeführt.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub DisableCommandButtons()
On Error GoTo DisableCommandButtons_Err
Dim ctlControl As Control
With Me
.cmdClose.SetFocus
For Each ctlControl In .Controls
With ctlControl
If .ControlType = acCommandButton Then
If .Name <> "cmdShowProfileDC" _
And .Name <> "cmdAddNewDC" _
And .Name <> "cmdSearch" _
And .Name <> "cmdDeleteDC" _
And .Name <> "cmdClose" Then
Call modPublic.CtlProperties(ctlControl, _
False, _
vbNullString)
End If
End If
End With
Next ctlControl
End With
DisableCommandButtons_Exit:
Exit Sub
DisableCommandButtons_Err:
Resume DisableCommandButtons_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: EnDisableLoadDCSelectTargetEnv
'
' Beschreibung: Befehlsschaltflächen cmdLoadDC und cmdSelectTargetEnv aktivieren/
' deaktivieren und Tipp Texte setzen/löschen.
'
' Parameter: boolEnabled
' strLoadTippText
' strSelectEnvTippText
'-------------------------------------------------------------------------------------'
Private Sub EnDisableLoadDCSelectTargetEnv(ByVal boolEnabled As Boolean, _
ByVal strLoadTippText As String, _
ByVal strSelectEnvTippText As String)
With Me
Call modPublic.CtlProperties(.cmdLoadDC, _
boolEnabled, _
strLoadTippText)
Call modPublic.CtlProperties(.cmdSelectTargetEnv, _
boolEnabled, _
strSelectEnvTippText)
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: ShowUserProfileDCProperties
'
' Beschreibung: cmdShowUserDC oder cmdShowProfileDC aktivieren/deaktivieren und auf
' sichtbar/unsichtbar einstellen.
'
' Parameter: ctlControl
' boolVisible
' boolEnabled
'-------------------------------------------------------------------------------------'
Private Sub ShowUserProfileDCProperties(ByVal ctlControl As Control, _
ByVal boolVisible As Boolean, _
ByVal boolEnabled As Boolean)
With ctlControl
.Visible = boolVisible
.Enabled = boolEnabled
End With
End Sub
'-------------------------------------------------------------------------------------'
' Funktion: SaveKeyControl
'
' Beschreibung: Steuert die Sicherung der Keys (Daten des Default Tabellentyps aus der
' Tabelle tblDB2Type) der Data Collection lngDCID.
'
' Parameter: strHostID
' strHostPWD
' lngDCID
' strDB2Env
'
' Rückgabe: SaveKeyControl
'-------------------------------------------------------------------------------------'
Public Function SaveKeyControl(ByVal strHostID As String, _
ByVal strHostPWD As String, _
ByVal lngDCID As Long, _
ByVal strDB2Env As String) As Boolean
On Error GoTo SaveKeyControl_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
Dim strODBCConnect As String
Dim strHostTable As String
Dim strAccTable As String
Dim strDB2ODBCCnn As String
strSQL = modSQL.QSelSaveKey(Format(lngDCID, modPublDecl.gconlngDCIDFmt), _
strDB2Env)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If Not .EOF Then
strDB2ODBCCnn = DB2ODBCCnn(strDB2Env)
If Len(strDB2ODBCCnn) <> 0 Then
Do Until .EOF
strHostTable = !CREATOR & modPublDecl.gconFullStop & !Tabelle
strAccTable = "ac" & !CREATOR & modPublDecl.gconUnderScore & !Tabelle
strODBCConnect = modPublic.ODBCCnnString(strDB2ODBCCnn, _
strHostTable)
Call modPublic.TransferTable(strODBCConnect, _
strHostTable, _
strAccTable, _
False, _
False)
Call SaveKey(lngDCID, _
strDB2Env, _
strAccTable, _
!Tabelle)
DoCmd.DeleteObject acTable, strAccTable
.MoveNext
DoEvents ' Ereignissteuerung an Betriebssystem übergeben
Loop
.Close
Else
Resume SaveKeyControl_Err
End If
End If
End With
SaveKeyControl = True
SaveKeyControl_Exit:
Set dbDAO = Nothing
Set rstDAO = Nothing
Exit Function
SaveKeyControl_Err:
SaveKeyControl = False
Call modPublic.DB2ConnectErr
Resume SaveKeyControl_Exit
End Function
'-------------------------------------------------------------------------------------'
' Funktion: SaveKey
'
' Beschreibung: Schreibt den Key der Tabelle strTabelle in die Access Tabelle
' tblDB2DMCMDCTablesKey.
'
' Parameter: lngDCID
' strAccTable
' strDB2Env
' strTabelle
'
' Rückgabe: SaveKey
'-------------------------------------------------------------------------------------'
Public Function SaveKey(ByVal lngDCID As Long, _
ByVal strAccTable As String, _
ByVal strDB2Env As String, _
ByVal strTabelle As String) As Long
On Error GoTo SaveKey_Err
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim dbDAOSaveKey As DAO.Database
Dim rstDAOSaveKey As DAO.Recordset
Dim strSQL As String
Dim lngNumKeysSaved As Long
strSQL = modSQL.QSelDistTableField(strAccTable, _
"DB2KeyVal")
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
strSQL = modSQL.QSelDelTable("tblDB2DMCMDCTablesKey", _
False)
Set dbDAOSaveKey = CurrentDb()
Set rstDAOSaveKey = dbDAOSaveKey.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAOSaveKey
Do Until .EOF
.AddNew
lngNumKeysSaved = lngNumKeysSaved + 1
!DCID = lngDCID
!Tabelle = strTabelle
!DB2KeyVal = rstDAO!DB2KeyVal
.Update
.MoveNext
Loop
.Close
rstDAO.Close
End With
SaveKey_Exit:
SaveKey = lngNumKeysSaved
Set dbDAO = Nothing
Set rstDAO = Nothing
Set dbDAOSaveKey = Nothing
Set rstDAOSaveKey = Nothing
Exit Function
SaveKey_Err:
Resume SaveKey_Exit ' Im Fehlerfall nächste Tabelle
End Function
'-------------------------------------------------------------------------------------'
' Funktion: NumKeysDelete
'
' Beschreibung: Ermittelt die Anzahl zu löschender Keys.
'
' Parameter: Ohne
'
' Rückgabe: NumKeysDelete
'-------------------------------------------------------------------------------------'
Private Function NumKeysDelete() As Long
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelCntKeyDelete(CLng(Me.txtDCID))
Set dbDAO = CurrentDb
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
If Not .EOF Then
NumKeysDelete = !NumRecs
End If
.Close
End With
Set dbDAO = Nothing
Set rstDAO = Nothing
End Function
'-------------------------------------------------------------------------------------'
' Funktion: NumKeysSaved
'
' Beschreibung: Ermittelt die Anzahl gesicherter Keys.
'
' Parameter: Ohne
'
' Rückgabe: NumKeysSaved
'-------------------------------------------------------------------------------------'
Private Function NumKeysSaved() As Long
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelCntDCIDKey(CLng(Me.txtDCID))
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenSnapshot)
With rstDAO
NumKeysSaved = IIf(Not .EOF, !NumRecs, 0)
.Close
End With
Set dbDAO = Nothing
Set rstDAO = Nothing
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: GetFormScreenInfo
'
' Beschreibung: Ermittelt die Bildschirmposition.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Public Sub GetFormScreenInfo()
Me_WPL.Length = 44
MDIC_WPL.Length = 44
Call modPublDecl.GetWindowPlacement(Me.hWnd, _
Me_WPL)
Call modPublDecl.GetWindowPlacement(GetMDIClientHWnd(), _
MDIC_WPL)
With Me_WPL.rcNormalPosition
Me_Width = .Right - .Left
Me_Height = .Bottom - .Top
With modPublDecl.ParentWindow
.lngWidth = Me_Width
.lngHeight = Me_Height
.lngTop = Me_WPL.rcNormalPosition.Top
.lngBottom = Me_WPL.rcNormalPosition.Bottom
.lngLeft = Me_WPL.rcNormalPosition.Left
.lngRight = Me_WPL.rcNormalPosition.Right
End With
MDIC_Width = .Right - .Left - 4 ' Rahmenbreite des Formulars berücksichtigen
modPublDecl.ChildWindow.lngWidth = MDIC_Width
MDIC_Height = .Bottom - .Top - 4 ' Rahmenbreite des Formulars berücksichtigen
modPublDecl.ChildWindow.lngHeight = MDIC_Height
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: ToggleProfileUserCmd
'
' Beschreibung: Aktiviert/deaktiviert die Befehlsschaltflächen cmdShowUserDC und
' cmdShowProfileDC und setzt die Tipp- und Statusleistentexte in
' Abhängigkeit davon, ob die Data Collections des angemeldeten Bearbeiters
' oder alle Data Collections der Arbeitsgruppe angezeigt werden.
'
' Parameter: boolUser
'-------------------------------------------------------------------------------------'
Private Sub ToggleProfileUserCmd(ByVal boolUser As Boolean)
On Error GoTo ToggleProfileUserCmd_Err
Const conSelDcAuthor1 As String = "Bearbeiter(in) "
Const conSelDcAuthor2 As String = "' auswählen "
Const conAllDataColls As String = "Alle" & modPublDecl.gconDataColls
Const conWorkGroup As String = "der Arbeitsgruppe"
Dim strTippText1 As String
Dim strTippText2 As String
strTippText2 = conSelDcAuthor1 & conWorkGroup & " '" & modPublDecl.gstrWorkGroup & _
conSelDcAuthor2
strTippText1 = "'" & modPublDecl.gstrWorkGroup & "' anzeigen "
With Me
If boolUser = False Then
Call ShowUserProfileDCProperties(.cmdShowUserDC, _
True, _
True)
strTippText1 = conAllDataColls & conSelDcAuthor1 & strTippText1
With .cmdShowUserDC
.ControlTipText = strTippText1 & modPublDecl.gconAltZ & vbCrLf & _
strTippText2 & modPublDecl.gconCtlZ
.StatusBarText = strTippText1 & "| " & strTippText2
.SetFocus
End With
.cmdShowProfileDC.Visible = False
ElseIf boolUser = True Then
Call ShowUserProfileDCProperties(.cmdShowProfileDC, _
True, _
True)
strTippText1 = conAllDataColls & conWorkGroup & " " & strTippText1
With .cmdShowProfileDC
.ControlTipText = strTippText1 & modPublDecl.gconAltZ & vbCrLf & _
strTippText2 & modPublDecl.gconCtlZ
.StatusBarText = strTippText1 & "| " & strTippText2
.SetFocus
End With
.cmdShowUserDC.Visible = False
End If
Call modPublic.CtlProperties(.cmdAddNewDC, _
boolUser, _
mconAddDCTipp)
End With
ToggleProfileUserCmd_Exit:
Exit Sub
ToggleProfileUserCmd_Err:
With Me
If .CurrentRecord > 0 Then ' Fehlermeldung, falls Daten vorhanden
Call modPublic.ShowMsgBox("Das Umschalten zwischen den Befehlsschaltflächen" & _
"'" & .cmdShowProfileDC.Name & "' und '" & _
.cmdShowUserDC.Name & "' verursachte einen Fehler!", _
modPublDecl.gconOkExcStyle, _
"Befehlsschaltflächen umschalten", _
True)
End If
End With
Resume ToggleProfileUserCmd_Exit
End Sub
