Office: (Office 2016) Fehler 6 -> Ãœberlauf

Hallo liebe Foren User.

ich hab ein Problem mit einer Accdb der mich total im dunklen tappen lässt.
Ich hab eine Inventar DB im Backend mit grob 21500 Datensätzen und rund 150 MB.
Das Frontend ist mit grob 25 MB auch nicht gerade schlank.

Nun mein Problem:
Ich habe einen Satz den ich zur Bearbeitung in einen temporäre Tabelle kopiere. (liegt im BE)
Wenn der User der Meinung ist, alles ist richtig, dann schreibe ich den Satz mit einer Aktualisieren Abfrage wieder zurück in die eigentliche Tabell.
Anschliessend wird der Eintrag in der Temp Tabelle wieder gelöscht.

Das Funktioniert soweit auch richtig.
NUR DANN KOMMT MANCHMAL DER VERDAMMTE FEHLER 6

Die Kollegen können den Vorgang des Schreibens mehrfach ohne Probleme ausführen, aber irgendwann kommt der Punkt, da meldet die Sub, die den Button Click Event ausführt, den Fehler 6.
In der Sub steht nichts anderes als der Aufruf einer Function.
Die Function hat auch Error Handling im VBA aber der Fehler wird in der Aufrufenden Sub gemeldet.

Man ließt, dass der Fehler 6 meist ein Integer Problem ist. (max grob 32T)
Die Variablen innerhalb der Functoin hab ich deswegen schon von integer auf Long geändert, aber das wars nicht.

Hat hier jemand eine Idee was noch Ursache eines Überlauf Fehlers sein könnte.

Gefühlt zieht sich die Anwendung zu.

Viele Grüße an alle die das hier lesen.
Hoffentlich hat jemand eine zündende Idee.

Christoph

:)

 

Wie schaut der Sub und die Funktion aus?

 

Private Sub BTN_Speichern_Click()
On Error GoTo Fehler
Pflege_HW.Pflege_F9_Speichern

Exit Sub

Fehler:
BasisBefehle.FehlerMeldenV2 "Form_Pflege_F9, BTN_Speichern_Click", Err.Number, Err.Source, Err.Description
End Sub

 

Die Function ist fast 60000 Zeichen, wie bekomme ich die hier rein?
Nach 30000 wird gemeckert ;-)

 

Function Pflege_F9_Speichern()
Dim SQLBefehlName As String
Dim SQLBefehlPREName As String
Dim RSVerbund As DAO.Recordset
Dim DBVerbund As DAO.Database
Dim VerbundName As Integer
Dim VerbundOrt As Integer
Dim VerbundNetz As Integer
Dim Antwort
Dim AntwortVerkn
Dim AntwortAbweichungOrt
Dim AntwortAbweichungNetz
Dim AntwortAbweichungOrtABSICHT
Dim Abweichung As Boolean
Dim RecordSetOFFEN As Boolean
Dim TMPVerbundTypSuche
Dim TMPSwitchBelegungString As String
Dim TMPPanelBelegungString As String
Dim TMPSwitchString As String
Dim TMPPanelString As String
Dim TMPSwitchStringAltGeraet As String
Dim TMPPanelStringAltGeraet As String
Dim PanelStringVeraendert, SwitchStringVeraendert As Boolean
Dim ModellAenderungPanelString, ModellAenderungSwitchString As String
Dim MaxPorts As Integer
Dim BelegungORG, BelegungsStringPatchA_NEU, BelegungsStringPatchA_ALT, BelegungsStringPatchB_NEU, BelegungsStringPatchB_ALT As String
Dim StartPos As Integer
Dim PatchA_TMP, PatchB_TMP As String ' am Ende der Function sind die Werte im Formular nicht mehr greifbar

Dim ErrorPos As Integer
Dim Fehlertext As String
Dim Fehlerhinweis As String
Dim PatchStringNICHTVeraendern As Boolean
Dim AntwortAbweichungKabelLeitungABSICHT

'wenn das Kennzeichen gesetzt ist darf dieses Objekt zusätzlich gepatcht sein.
If DLookup("GRP_Patchung2", "modelle", "Modell_ID like " & Form_PFLEGE_F9.KMB_Modell) Then PatchStringNICHTVeraendern = True Else PatchStringNICHTVeraendern = False

On Error GoTo Fehler

BasisBefehle.KabelLeitungAenderungGewollt = True

DoCmd.Hourglass True
AntwortAbweichungOrt = 0
AntwortAbweichungNetz = 0
Form_PFLEGE_F9.Refresh

DoCmd.SetWarnings False
Form_PFLEGE_F9.PRIMAERSCHLUESSEL.SetFocus

'Nach Modellwechsel Felder bereinigen
ErrorPos = 1
If BasisBefehle.GRP_PatchungGeaendert _
Or BasisBefehle.GRP_NetzwerkDatenGeaendert _
Or BasisBefehle.GRP_DruckerGeandert _
Or BasisBefehle.GRP_MausTastDatGeaendert _
Or BasisBefehle.GRP_NetzGeaendert _
Or BasisBefehle.GRP_NameGeaendert _
Or BasisBefehle.GRP_TelNrGeaendert _
Or BasisBefehle.GRP_NetznameBSGeaendert _
Or BasisBefehle.GRP_CIMGeaendert _
Or BasisBefehle.GRP_LeitungGeaendert _
Or BasisBefehle.GRP_SBGeaendert _
Or BasisBefehle.GRP_JaNeinFelderGeaendert _
Or BasisBefehle.GRP_PortanzahlGeaendert _
Or BasisBefehle.GRP_AlarmOverIPGeaendert Then 'or Basisbefehle.GRP_WegVerlaufGeandert
If BasisBefehle.GRP_PatchungGeaendert Then
If Not DLookup("GRP_Patchung", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
'Den Belegungsstring von Panel unf Switch noch leeren
PanelStringVeraendert = False

If Not IsNull(Form_PFLEGE_F9.KMB_DOSEN_PanelSchluessel) Then
If Not IsNull(Form_PFLEGE_F9.DOSEN_Port) Then
ModellAenderungPanelString = StringZeichenNachPositionErsetzen(Form_PFLEGE_F9.TXT_PanelBelegung_ALT.Caption, "O", Form_PFLEGE_F9.DOSEN_Port)
PanelStringVeraendert = True
End If
End If

SwitchStringVeraendert = False
If Not IsNull(Form_PFLEGE_F9.KMB_Switchschluessel) Then
If Not IsNull(Form_PFLEGE_F9.PORTNR) Then
ModellAenderungSwitchString = StringZeichenNachPositionErsetzen(Form_PFLEGE_F9.TXT_SwitchBelegung_ALT.Caption, "O", Form_PFLEGE_F9.PORTNR)
SwitchStringVeraendert = True
End If
End If

Form_PFLEGE_F9.KMB_DOSEN_PanelSchluessel = Null
Form_PFLEGE_F9.TXT_DOSEN_PanelSCHLUESSEL = Null
Form_PFLEGE_F9.DOSEN_Port = Null
Form_PFLEGE_F9.KMB_Switchschluessel = Null
Form_PFLEGE_F9.TXT_Switchschluessel = Null
Form_PFLEGE_F9.PORTNR = Null
Form_PFLEGE_F9.DOSEN_Freitext = Null
End If
End If
If BasisBefehle.GRP_NetzwerkDatenGeaendert Then
If Not DLookup("GRP_NetzwerkDaten", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.IP_ADRESSE = Null
Form_PFLEGE_F9.MAC_ADR = Null
End If
End If
If BasisBefehle.GRP_DruckerGeandert Then
If Not DLookup("GRP_Drucker", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.Trommelwechsel = Null
Form_PFLEGE_F9.SEITEN = Null
Form_PFLEGE_F9.Stand = Null
End If
End If
If BasisBefehle.GRP_MausTastDatGeaendert Then
If Not DLookup("GRP_MausTastDat", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.Maus = Null
Form_PFLEGE_F9.Tastatur = Null
End If
End If
If BasisBefehle.GRP_NetzGeaendert Then
If Not DLookup("GRP_Netz", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.NETZ = 0
End If
End If
If BasisBefehle.GRP_NameGeaendert Then
If Not DLookup("GRP_Name", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.MZ_PRE_Name = Null
Form_PFLEGE_F9.KMB_MZ_Name = Null
Form_PFLEGE_F9.MZ_Name = Null
End If
End If
If BasisBefehle.GRP_TelNrGeaendert Then
If Not DLookup("GRP_TelNr", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.TELNR = Null
Form_PFLEGE_F9.TELAufzeichnung = 0
End If
End If
If BasisBefehle.GRP_NetznameBSGeaendert Then
If Not DLookup("GRP_NetznameBS", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.Netzname = Null
'Form_PFLEGE_F9.BETRIEBSSYSTEM = 1
Form_PFLEGE_F9.BSYSNR = 1
Form_PFLEGE_F9.KMB_Betriebssystem = 1
End If
End If
If BasisBefehle.GRP_CIMGeaendert Then
If Not DLookup("GRP_CIM", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.cim_s = Null
End If
End If
If BasisBefehle.GRP_LeitungGeaendert Then
If Not DLookup("GRP_Leitung", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.LEITUNGSKAPAZITAET = Null
End If
End If
If BasisBefehle.GRP_SBGeaendert Then
If Not DLookup("GRP_SB", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.PNNR = Null
Form_PFLEGE_F9.KONTONR = Null
End If
End If
If BasisBefehle.GRP_JaNeinFelderGeaendert Then
If Not DLookup("GRP_JaNeinFelder", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.CHK_Telefonie = False
Form_PFLEGE_F9.CHK_SWDepot = False
Form_PFLEGE_F9.CHK_VM = False
Form_PFLEGE_F9.CHK_BankBasisAP = False
Form_PFLEGE_F9.CHK_Sicherheit = False
Form_PFLEGE_F9.TXT_BarUnbarKasse = Null
End If
End If
If BasisBefehle.GRP_PortanzahlGeaendert Then
If Not DLookup("GRP_Portanzahl", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.PORTANZAHL = Null
Form_PFLEGE_F9.PORTANZAHL_Verfuegbar = Null
End If
End If
If BasisBefehle.GRP_AlarmOverIPGeaendert Then
If Not DLookup("GRP_AlarmOverIP", "Modelle", "Modell_ID = " & Form_PFLEGE_F9.KMB_Modell) Then
Form_PFLEGE_F9.IBS_ID = Null
End If
End If

Form_VORGABE_GESAMT.INVENTARKEY = Form_PFLEGE_F9.PRIMAERSCHLUESSEL
'DoCmd.Requery
End If
If Not IsNull(Form_PFLEGE_F9.KMB_Verbundschluessel) And Form_PFLEGE_F9.KMB_Verbundschluessel "" Then
TMPVerbundTypSuche = DLookup("Typ", "Hardware_abfrage", "Primaerschluessel = '" & Form_PFLEGE_F9.KMB_Verbundschluessel & "'")
Else
MsgBox "Der Verbundschlüssel konnte nicht ausgelesen werden, dieser ist jedoch zwingend notwendig!" & vbNewLine & "Bittel prüfen Sie die Angabe im betreffenden Feld.", vbCritical + vbOKOnly, "Fehler"
Exit Function
TMPVerbundTypSuche = ""
End If
'Die Switch und Panel Belegung muss gesichert werden
'zuvor muss geprüft werden ob jemand anderes in der gleichen Zeit eine Patchung am gleichen Switch eingetragen hat.
'If Form_PFLEGE_F9.TXT_SwitchBelegung Form_PFLEGE_F9.TXT_SwitchBelegung_ALT.Caption Then
If BasisBefehle.SwitchPortVeraendert Or BasisBefehle.SwitchVeraendert Or BasisBefehle.PanelPortVeraendert Or BasisBefehle.PanelVeraendert Then
'-------------------------------------------------------------------------------------------------------------------------------------------
'Sollte ein Satz in Lager, Schrott oder Werkstatt gebucht worden sein, dann müssen nur die alt Einträge bereinigt werden!
If Form_PFLEGE_F9.KMB_Ort.Column(6) = "S" Or Form_PFLEGE_F9.KMB_Ort.Column(6) = "W" Or Form_PFLEGE_F9.KMB_Ort.Column(6) = "L" Then
If Not IsNull(Form_PFLEGE_F9.TXT_SwitchSchluessel_Alt) And Form_PFLEGE_F9.TXT_SwitchSchluessel_Alt "" Then 'alten Switcheintrag wieder als frei eintragen
Form_VORGABE_GESAMT.SUCHKEY = Form_PFLEGE_F9.TXT_SwitchSchluessel_Alt
MaxPorts = DLookup("PortAnzahl", "Hardware", "PRIMAERSCHLUESSEL = '" & Form_PFLEGE_F9.TXT_SwitchSchluessel_Alt & "'")
BelegungORG = DLookup("PORTBELEGUNG", "Hardware", "Primaerschluessel= '" & Form_PFLEGE_F9.TXT_SwitchSchluessel_Alt & "'")
StartPos = 1

While StartPos

 

If BasisBefehle.SwitchVeraendert And BasisBefehle.SwitchPortVeraendert Then 'Patchung A wurde geändert und der alte Panel muss auch korrigiert werden
If Not IsNull(Form_PFLEGE_F9.KMB_Switchschluessel) And Not IsNull(Form_PFLEGE_F9.PORTNR) Then ' wenn gar nicht neu eingetragen wurde dann machen wir hier auch nix
Form_VORGABE_GESAMT.SUCHKEY = Form_PFLEGE_F9.KMB_Switchschluessel
PatchA_TMP = Form_PFLEGE_F9.KMB_Switchschluessel 'Wird am Ende benötigt
MaxPorts = DLookup("PortAnzahl", "Hardware", "PRIMAERSCHLUESSEL = '" & Form_PFLEGE_F9.KMB_Switchschluessel & "'")
BelegungORG = DLookup("PORTBELEGUNG", "Hardware", "Primaerschluessel= '" & Form_PFLEGE_F9.KMB_Switchschluessel & "'")
StartPos = 1
If Not PatchStringNICHTVeraendern Then 'bei Sätzen die eine zusätzliche Patchung belegen dürfen (z.B. Dosen) werden keine Belegungen im Sting eingetragen!

While StartPos

 

'BTN F2 Sichtbare machen, den Rest macht die Initial Function

'---------------------------------------------------------------------------------------------------------------------------------------
'- Sollte es sich um ein Kabel Handeln werden unterschiedliche Standorte akzeptiert
'- Dies gilt auch wenn das Gerät im Verbund eine Leitung oder ein Kabel ist
'---------------------------------------------------------------------------------------------------------------------------------------

If BasisBefehle.AbweichenderOrt = False Then
If Form_PFLEGE_F9.TYP Like "*Kabel*" Or Form_PFLEGE_F9.TYP Like "Leitung*" Then 'Bei Kabeln kann es gewollt sein u. a. den Ort und das Zimmer beizubehalten
If DCount("*", "hardware_Verbund") > 1 Then
AntwortAbweichungOrtABSICHT = MsgBox("Der Datensatz steht mit mindestens einem weiteren Satz im Verbund " & vbNewLine & "der mit dem Namen und oder dem Ort abweicht!" & vbNewLine & vbNewLine & "Dies kann bei Kabeln und Leitungen gewollt sein, ist jedoch eher die Ausnahme" & vbNewLine & vbNewLine & "Sollen alle im Verbund existierenden Datensätze an den Hauptverbund angepasst werden?", vbExclamation + vbYesNo + vbDefaultButton2, "Frage")
If AntwortAbweichungOrtABSICHT = vbYes Then BasisBefehle.AbweichenderOrt = False Else BasisBefehle.AbweichenderOrt = True
End If
End If
' Abfrage ob der Verbundschluessel ein Kabel oder eine Leitung ist -Neu seit 06.02.2019
If Form_PFLEGE_F9.PRIMAERSCHLUESSEL Form_PFLEGE_F9.KMB_Verbundschluessel Then
If TMPVerbundTypSuche Like "*Kabel*" Or TMPVerbundTypSuche Like "Leitung*" Then
If DCount("*", "hardware_Verbund") > 1 Then
AntwortAbweichungOrtABSICHT = MsgBox("Der Datensatz steht mit mindestens einem weiteren Satz im Verbund " & vbNewLine & "der mit dem Namen und oder dem Ort abweicht!" & vbNewLine & vbNewLine & "Dies kann bei Kabeln und Leitungen gewollt sein, ist jedoch eher die Ausnahme" & vbNewLine & vbNewLine & "Sollen alle im Verbund existierenden Datensätze an den Hauptverbund angepasst werden?", vbExclamation + vbYesNo + vbDefaultButton2, "Frage")
If AntwortAbweichungOrtABSICHT = vbYes Then BasisBefehle.AbweichenderOrt = False Else BasisBefehle.AbweichenderOrt = True
End If
End If
End If
'---------------------------------------------------------------------------------------
If Form_PFLEGE_F9.VERBUNDSCHLUESSEL = Form_PFLEGE_F9.PRIMAERSCHLUESSEL Then
'Dim AntwortAbweichungenVerbund
If DCount("*", "hardware_Verbund_Count") > 1 Then
If Nz(DCount("*", "hardware_Verbund_Kabel_Leitung"), 0) >= 1 Then

'MsgBox "Im Verbund sind " & DCount("*", "hardware_Verbund_Kabel_Leitung") & " Leitungen oder Kabel betroffen"
If DCount("*", "hardware_Verbund_Kabel_Leitung") = 1 Then
AntwortAbweichungKabelLeitungABSICHT = MsgBox("In den Verknüpfungen zu diesem Datensatz " _
& vbNewLine & "ist 1 weiterer Datensätze vom Typ Leitung oder Kabel " & vbNewLine & "mit möglicherweise abweichenden Informationen " _
& vbNewLine & "zu Name, Ort, Zimmer, Raumtyp oder Stelle!" _
& vbNewLine & vbNewLine & "Soll dieser Satz im Verbund die gleichen Daten erhalten?", vbInformation + vbYesNo + vbDefaultButton2, "Frage")
Else
AntwortAbweichungKabelLeitungABSICHT = MsgBox("In den Verknüpfungen zu diesem Datensatz " _
& vbNewLine & "sind " & DCount("*", "hardware_Verbund_Kabel_Leitung") & " weitere Datensätze vom Typ Leitung oder Kabel " & vbNewLine & "mit möglicherweise abweichenden Informationen " _
& vbNewLine & "zu Name, Ort, Zimmer, Raumtyp oder Stelle!" _
& vbNewLine & vbNewLine & "Sollen diese Sätze im Verbund die gleichen Daten erhalten?", vbInformation + vbYesNo + vbDefaultButton2, "Frage")
End If
If AntwortAbweichungKabelLeitungABSICHT = vbYes Then
'MsgBox "AntwortJA"
BasisBefehle.KabelLeitungAenderungGewollt = True
Else
'MsgBox "AntwortNö"
BasisBefehle.KabelLeitungAenderungGewollt = False
End If
End If
End If
End If
If AntwortAbweichungOrtABSICHT = vbYes Then 'wenn die Abweichng von Ort und Name nicht gewünscht ist, dann hier die richtigen Werte holen
If Form_PFLEGE_F9.PRIMAERSCHLUESSEL Form_PFLEGE_F9.KMB_Verbundschluessel Then
Set RSVerbund = CurrentDb.OpenRecordset("select * from hardware where Primaerschluessel like '" & Form_PFLEGE_F9.KMB_Verbundschluessel & "'")
RecordSetOFFEN = True
'If DLookup("MZ_Name", "Hardware", "Primaerschluessel = '" & Form_PFLEGE_F9.KMB_Verbundschluessel & "'") Form_PFLEGE_F9.MZ_Name Then VerbundName = 1
If RSVerbund!MZ_Name Form_PFLEGE_F9.MZ_Name Then VerbundName = 1
'If DLookup("STELLENNR", "Hardware", "Primaerschluessel = '" & Form_PFLEGE_F9.KMB_Verbundschluessel & "'") Form_PFLEGE_F9.KMB_Ort Then VerbundOrt = 1
If AntwortAbweichungOrtABSICHT = False Then If RSVerbund!STELLENNR Form_PFLEGE_F9.KMB_Ort Then VerbundOrt = 1
'If DLookup("NETZ", "Hardware", "Primaerschluessel = '" & Form_PFLEGE_F9.KMB_Verbundschluessel & "'") Form_PFLEGE_F9.KMB_Netz Then VerbundNetz = 1
If RSVerbund!NETZ Form_PFLEGE_F9.KMB_Netz Then VerbundNetz = 1
Else
RecordSetOFFEN = False
End If
End If
End If
If BasisBefehle.AbweichenderOrt = True Then
If TMPVerbundTypSuche Like "*Kabel-*" Or TMPVerbundTypSuche Like "Leitung*" Then
If VerbundName = 1 Or VerbundOrt = 1 Or VerbundNetz = 1 Then
If VerbundName = 1 Or VerbundOrt = 1 Then
AntwortAbweichungOrt = MsgBox("Der Datensatz steht mit einem weiteren Satz im Verbund " & vbNewLine & "der mit dem Namen und oder dem Ort abweicht!" & vbNewLine & vbNewLine & "Dies kann bei Kabeln gewollt sein, ist jedoch eher die Ausnahme" & vbNewLine & vbNewLine & "Sollen alle im Verbund existierenden Datensätze an den Hauptverbund angepasst werden?", vbExclamation + vbYesNo, "Frage")
Abweichung = True
End If
If VerbundNetz = 1 Then
AntwortAbweichungNetz = MsgBox("Der Datensatz steht mit einem weiteren Satz im Verbund " & vbNewLine & "der nicht im gleichen Netz gebucht ist" & vbNewLine & vbNewLine & "Dies kann gewollt sein, ist jedoch eher die Ausnahme" & vbNewLine & vbNewLine & "Sollen alle im Verbund existierenden Datensätze an den Hauptverbund angepasst werden?", vbQuestion + vbYesNo, "Frage")
Abweichung = True
End If
End If
End If
Else
'-----------------------------------------------------------------------------------
'hier muss noch die existenz eines Verbund geprüft werden!!! Die Ausgabe ist pauschal falsch
If DCount("*", "Hardware_verbund") > 1 Then
If VerbundName = 1 Or VerbundOrt = 1 Or VerbundNetz = 1 Then
If VerbundName = 1 Or VerbundOrt = 1 Then
MsgBox "Der Datensatz steht mit einem weiteren Satz im Verbund " & vbNewLine & "der mit dem Namen und oder dem Ort abweicht!" & vbNewLine & vbNewLine & "Alle im Verbund existierenden Datensätze werden an den Hauptverbund angepasst!", vbOKOnly + vbInformation, "Information"
AntwortAbweichungOrt = 6
Abweichung = True
Else
AntwortAbweichungOrt = 7
End If
If VerbundNetz = 1 Then
MsgBox "Der Datensatz steht mit einem weiteren Satz im Verbund " & vbNewLine & "der nicht im gleichen Netz gebucht ist" & vbNewLine & vbNewLine & "Alle im Verbund existierenden Datensätze werden an den Hauptverbund angepasst werden!", vbOKOnly + vbInformation, "Information"
AntwortAbweichungNetz = 6
Abweichung = True
Else
AntwortAbweichungNetz = 7
End If
End If
End If
'-----------------------------------------------------------------------------------

End If
'---------------------------------------------------------------------------------------------------------------------------------------
'Stelle muss bei Verbundänderung noch angepasst werden
Select Case AntwortAbweichungOrt
Case 6 'ist Ja
BasisBefehle.VerbundAenderungVerhindern = False
If BasisBefehle.VerbundInAenderung = 1 Then
If Form_PFLEGE_F9.KMB_Verbundschluessel.Column(6) = "" Then Form_PFLEGE_F9.RAUMTYP = Null Else Form_PFLEGE_F9.RAUMTYP = Form_PFLEGE_F9.KMB_Verbundschluessel.Column(6)
If Form_PFLEGE_F9.KMB_Verbundschluessel.Column(7) = "" Then Form_PFLEGE_F9.ZINR = Null Else Form_PFLEGE_F9.ZINR = Form_PFLEGE_F9.KMB_Verbundschluessel.Column(7)
Form_PFLEGE_F9.KMB_Ort = Form_PFLEGE_F9.KMB_Verbundschluessel.Column(8)
If Form_PFLEGE_F9.KMB_Verbundschluessel.Column(3) = "" Then Form_PFLEGE_F9.MZ_PRE_Name = Null Else Form_PFLEGE_F9.MZ_PRE_Name = Form_PFLEGE_F9.KMB_Verbundschluessel.Column(3)
If Form_PFLEGE_F9.KMB_Verbundschluessel.Column(4) = "" Then Form_PFLEGE_F9.MZ_Name = Null Else Form_PFLEGE_F9.MZ_Name = Form_PFLEGE_F9.KMB_Verbundschluessel.Column(4)

Form_PFLEGE_F9.Refresh
End If
Case 7 ' ist Nein
BasisBefehle.VerbundAenderungVerhindern = True
Form_PFLEGE_F9.ORT = Form_PFLEGE_F9.KMB_Ort.Column(2)

End Select
Select Case AntwortAbweichungNetz
Case 6
'Hier fehlt noch die Netz änderung
Case 7
BasisBefehle.VerbundAenderungVerhindern = True
End Select
'Bei noch bestehenden Drucker Verknüpfungen aufräumen
Select Case Form_PFLEGE_F9.KMB_Ort.Column(6)
Case "S", "L"
If Form_PFLEGE_F9.LISTVerknuepfung.ListCount > 0 Then
AntwortVerkn = MsgBox("Zu diesem Datensatz werden " & vbNewLine & "beim Speichern " & Form_PFLEGE_F9.LISTVerknuepfung.ListCount & " Verknüpfungen gelöscht!" & vbNewLine & vbNewLine & "Wollen Sie fortfahren?", vbQuestion + vbYesNo, "Frage")
If AntwortVerkn = 7 Then ' 7 = Nein 6 = Ja
DoCmd.Hourglass False
Exit Function
Else
Schreiben_VerknuepfungAusTabelle_Loeschen
'CurrentDb.Execute "DELETE FROM Haverk WHERE Verkn_Key = '" & Form_VORGABE_GESAMT.INVENTARKEY & "'';"
End If

End If
Case "W"
'#'#'
End Select

If Form_PFLEGE_F9.KMB_Ort.Column(6) = "S" Or Form_PFLEGE_F9.KMB_Ort.Column(6) = "L" Or Form_PFLEGE_F9.KMB_Ort.Column(6) = "W" Then
If Form_PFLEGE_F9.LISTVerknuepfung.ListCount > 0 Then
AntwortVerkn = MsgBox("Zu diesem Datensatz werden " & vbNewLine & "beim Speichern " & Form_PFLEGE_F9.LISTVerknuepfung.ListCount & " Verknüpfungen gelöscht!" & vbNewLine & vbNewLine & "Wollen Sie fortfahren?", vbQuestion + vbYesNo, "Frage")
If AntwortVerkn = 7 Then ' 7 = Nein 6 = Ja
DoCmd.Hourglass False
Exit Function
Else
Schreiben_VerknuepfungAusTabelle_Loeschen
'CurrentDb.Execute "DELETE FROM Haverk WHERE Verkn_Key = '" & Form_VORGABE_GESAMT.INVENTARKEY & "'';"
End If

End If
End If
'Wenn ein Satz zu einem Verbund hinzugefügt wurde muss auch der Name aus Hauptverbund eingesetzt werden
If Form_PFLEGE_F9.PRIMAERSCHLUESSEL Form_PFLEGE_F9.KMB_Verbundschluessel Then

If Abweichung = True Then ' Die folgenden Werte werden analog dem Hauptverbund gesetzt, AUSNAHME geht nur bei Kabel-* und Leitung*
Form_PFLEGE_F9.MZ_Name = RSVerbund!MZ_Name

Form_PFLEGE_F9.MZ_PRE_Name = RSVerbund!MZ_PRE_Name

Form_PFLEGE_F9.KMB_Ort = RSVerbund!STELLENNR

If VerbundName = 1 And VerbundOrt = 0 Then MsgBox "Der Name im Datensatz wird auf den gleichen Namen geändert," & vbNewLine & "wie der des Hauptverbunds!", vbInformation, "Information"
If VerbundOrt = 1 And VerbundName = 0 Then MsgBox "Der Ort wird auf den gleichen Ort geändert," & vbNewLine & "wie der des Hauptverbunds!", vbInformation, "Information"
If VerbundName = 1 And VerbundOrt = 1 Then MsgBox "Der Name und der Ort werden auf die gleichen Werte geändert," & vbNewLine & "wie der Hauptverbund!", vbInformation, "Information"

If VerbundNetz = 1 Then
Antwort = MsgBox("Das Netz im aktuellen Datensatz entspricht nicht dem des Hauptverbunds (Netz " & RSVerbund!NETZ & ")" & vbNewLine & vbNewLine & "Soll das Netz auf das passende Netz korrigiert werden?", vbQuestion + vbYesNo, "Frage")
If Antwort = vbYes Then
Form_PFLEGE_F9.KMB_Netz = RSVerbund!NETZ
End If
End If
Abweichung = False
End If

'BasisBefehle.VerbundInAenderung = 0
Form_VORGABE_GESAMT.VERBUNDKEY = Form_PFLEGE_F9.TXT_VerbundSchluessel

'End If
Else
'Ist der Verbund gleich dem Primärschlüssel
'If BasisBefehle.VerbundGeloescht = True Then

End If
If BasisBefehle.PatchungLoeschen Then 'Letzten Ort eintragen
Fehlerhinweis = "Letzer Ort soll ausgelesen werden."
Dim TMPLetzterOrt As Long
TMPLetzterOrt = CLng(Form_PFLEGE_F9.TXT_StelleNr_Alt)
Fehlerhinweis = Fehlerhinweis & " TMPLetzterOrt hat " & TMPLetzterOrt
If Not IsNull(TMPLetzterOrt) Then Form_PFLEGE_F9.LETZTER_ORT = DLookup("Ort", "Stelle", "lfdnr like '" & TMPLetzterOrt & "'") Else Form_PFLEGE_F9.LETZTER_ORT = "unbekannt"
End If
Fehlerhinweis = ""
'Bei Geräten die auf Schrott geschreiben werden werden einige Felder entfernt
Select Case Form_PFLEGE_F9.KMB_Ort.Column(6)
Case "S"
'Form_PFLEGE_F9.LIZENZSCHEIN = Null
'Form_PFLEGE_F9.MIETSCHEIN = Null
'Form_PFLEGE_F9.KMB_MietWart = Null
'Form_PFLEGE_F9.TXT_MietWart = Null

Form_PFLEGE_F9.MZ_PRE_Name = Null
Form_PFLEGE_F9.MZ_Name = Null
Form_PFLEGE_F9.KMB_RaumTyp = Null
Form_PFLEGE_F9.TXT_RaumTyp = Null
Form_PFLEGE_F9.ZimmerNR = Null
Form_PFLEGE_F9.TELNR = Null

Form_PFLEGE_F9.KMB_DOSEN_PanelSchluessel = Null
Form_PFLEGE_F9.KMB_DOSEN_PanelSchluessel2 = Null
Form_PFLEGE_F9.DOSE = Null
Form_PFLEGE_F9.KMB_Switchschluessel = Null
Form_PFLEGE_F9.KMB_Switchschluessel2 = Null
Form_PFLEGE_F9.PORTNR = Null
'Schreiben.Schreiben_VerknuepfungAusTabelle_Loeschen

Case "L", "W"
Form_PFLEGE_F9.MZ_PRE_Name = Null
Form_PFLEGE_F9.MZ_Name = Null
Form_PFLEGE_F9.KMB_RaumTyp = Null
Form_PFLEGE_F9.TXT_RaumTyp = Null
Form_PFLEGE_F9.ZimmerNR = Null

Form_PFLEGE_F9.KMB_DOSEN_PanelSchluessel = Null
Form_PFLEGE_F9.KMB_DOSEN_PanelSchluessel2 = Null
Form_PFLEGE_F9.DOSE = Null
Form_PFLEGE_F9.KMB_Switchschluessel = Null
Form_PFLEGE_F9.KMB_Switchschluessel2 = Null
Form_PFLEGE_F9.PORTNR = Null
'Schreiben.Schreiben_VerknuepfungAusTabelle_Loeschen

End Select
BasisBefehle.VerbundInAenderung = 0
BasisBefehle.F9SatzmerkenErzwingen = True
DoCmd.Requery 'Kein Requery, keine Freigabe das Datensatzes
Form_PFLEGE_F9.Requery
Schreiben.Schreiben_Historie_schreiben
Schreiben.Schreiben_Hardware_schreiben
If BelegungsStringPatchA_NEU "" Then
Schreiben.Schreiben_BelegungsString_schreiben PatchA_TMP, BelegungsStringPatchA_NEU
End If
If BelegungsStringPatchA_ALT "" Then
Schreiben.Schreiben_BelegungsString_schreiben Form_PFLEGE_F9.TXT_SwitchSchluessel_Alt, BelegungsStringPatchA_ALT
End If
If BelegungsStringPatchB_NEU "" Then
Schreiben.Schreiben_BelegungsString_schreiben PatchB_TMP, BelegungsStringPatchB_NEU
End If
If BelegungsStringPatchB_ALT "" Then
Schreiben.Schreiben_BelegungsString_schreiben Form_PFLEGE_F9.TXT_Dosen_PanelSchluessel_Alt, BelegungsStringPatchB_ALT
End If
'Schreiben der SwitchPanel Belegungsstrings FEHLT hier noch

Fehlerhinweis = "FormPflegeF9.VerbSchlALT hat " & Form_PFLEGE_F9.TXT_VerbundSchluessel_ALT & " VorgabeGesamt.Verbundkey hat " & Form_VORGABE_GESAMT.VERBUNDKEY

'BasisBefehle.Hardware_Zugriff_entfernen (Form_PFLEGE_F9.TXT_VerbundSchluessel_ALT)
' Ein User kann an einem Rechner immer nur ein Veränderung bearbeiten. Daher alle Einträge löschen die mit User und AP übereinstimmen.
BasisBefehle.Hardware_Zugriff_entfernen_OHNE_Verbundschluessel
' Entfernt Grund: siehe zwei zeilen höher
'If Not IsNull(Form_VORGABE_GESAMT.VERBUNDKEY) Then BasisBefehle.Hardware_Zugriff_entfernen (Form_VORGABE_GESAMT.VERBUNDKEY)

'alle Merker wieder leeren
Form_PFLEGE_F9.TXT_Primaerschluessel_Alt = ""
Form_PFLEGE_F9.TXT_VerbundSchluessel_ALT = ""
Form_PFLEGE_F9.TXT_RaumTyp_ALT = ""
Form_PFLEGE_F9.TXT_ZINR_ALT = ""
Form_PFLEGE_F9.TXT_PortNr_Alt = ""
Form_PFLEGE_F9.TXT_PanelPortNr_Alt = ""
Form_PFLEGE_F9.TXT_MODELLNR_Alt = ""
Form_PFLEGE_F9.TXT_TelNr_Alt = ""
Form_PFLEGE_F9.TXT_StelleNr_Alt = ""
Form_PFLEGE_F9.TXT_Name_Alt = ""
Form_PFLEGE_F9.TXT_AnzahlPorts_ALT = ""
Form_PFLEGE_F9.KMB_Netz.Tag = ""
Form_PFLEGE_F9.TXT_BS_Alt = ""
Form_PFLEGE_F9.TXT_SwitchSchluessel_Alt = ""
Form_PFLEGE_F9.TXT_Dosen_PanelSchluessel_Alt = ""

Form_PFLEGE_F9.BTN_OrtVeraendern.Visible = False

BelegungsStringPatchA_NEU = ""
BelegungsStringPatchA_ALT = ""
BelegungsStringPatchB_NEU = ""
BelegungsStringPatchB_ALT = ""

Form_PFLEGE_F9.BTN_F8.Visible = True
Pflege_F9_FeldFarben_auf_Standard
BasisBefehle.SchreibModusAN = 0
BasisBefehle.VerbundAenderungVerhindern = False
BasisBefehle.SwitchPanelDetailRequeryNotwendig = True
BasisBefehle.AbweichenderOrt = False
BasisBefehle.PatchungLoeschen = False
BasisBefehle.KabelLeitungAenderungGewollt = True
Form_PFLEGE_F9.RecordSource = "Hardware_Ausstattung"
BasisBefehle.DIALitBlockieren = 0 'Damit Dialit wieder reagiert
BasisBefehle.PflegeF9INIT = 0
Form_PFLEGE_F9.LISTVerbund.Requery
Pflege_HW.F9_FormularLaden_Initial_V2

BasisBefehle.RequeryErforderlichNachSpeicherung = True

'############################################################################### ######################################
'############ PDF LOGGING ################################################################################ ############
'BasisBefehle.MachEinPDFdraus "F9Speichern"
'############################################################################### ######################################
Form_PFLEGE_F9.BTN_OrtVeraendern.Visible = False

Form_PFLEGE_F9.TXT_Tools.Visible = True
Form_PFLEGE_F9.RE_Tools.Visible = True
Form_PFLEGE_F9.PIC_ToolsAufZu.Visible = True
Form_PFLEGE_F9.LISTUserGesamt.Requery

DoCmd.Hourglass False
BasisBefehle.ListenRefresh = 0
'If Form_VORGABE_GESAMT.DB_Admini = -1 Then ' DoCmd.SetWarnings true Else DoCmd.SetWarnings False

'____________________________________

If RecordSetOFFEN = True Then 'Recordset wird nur geschlossen wenn es zuvor geöffnet wurde
RSVerbund.Close
Set RSVerbund = Nothing
RecordSetOFFEN = False
End If
'____________________________________

Exit Function


Fehler:
Fehlertext = "Pflege_HW.Pflege_F9_Speichern Schritt " & ErrorPos & " " & Fehlerhinweis
BasisBefehle.FehlerMeldenV2 Fehlertext, Err.Number, Err.Source, Err.Description
'BasisBefehle.FehlerMelden Fehlertext
End Function

 

Schöner Spaghetti Code. *grins *grins


Weißt du bei welcher Anweisung es zu dem Fehler kommt?

Wenn der Fehler wiederholbar ist, dann kannst du ja debuggen und den Fehler einfach finden. Einfach ein Resume in die Error Anweisung einfügen, dann solltest du die problematische Zeile sehen.

 

Für solche Massen an Spaghetti nutzt Du bitte besser eine Textdatei als Anhang. Auch bei einer Aufteilung auf mehrere Nachrichten wird das Lesen der Riesenfunktion nicht besser, eher schlechter.
PS: habe ja schon viele Functionen gesehen aber noch nie einen solchen Roman. Kein Wunder, das der Fehler 6 aufläuft. Das wird bei der Menge an Zeilen auch so bleiben.
Programmcode-Limitationen
In diesem Kapitel werden die Limitationen für Programmcode vorgestellt.

 

Hallo Markus, hallo Elmar,

vielen Dank dass ihr euch meinem Thema angenommen habt.
@markus: Nein ich habe ja in beiden Teilen das Fehler Handling an.
Der Fehler wird aber in der Sub verursact, bzw. ausgelöst.
Ich denke zwar auch nicht dass es an den 3 Zeilen der Sub liegen kann, aber in der Function kommt der Fehler nicht zur Ausgabe.
Und NEIN, ich kann den Fehler nicht reproduzieren.
Es Nervt mich auch, aber es passiert nur sporadisch. 1000 mal probiert 1000 mal ist nix passiert, 10001 ..... und es hat bum gemacht :-)
Also kann ich leider nix debuggen.

@ Elmar:
Was schlägst du vor was ich gegen die länge an Codes machen kann.
Wird es für VBA besser wenn ich Teile in unterfunktionen stecke?
Oder hast du bessere Ideen wie ich den ganzen Kram kürzer bekomme?
Sind ja ganz viele Elemente die formatiert werden müssen in abhängigkeit von zig bedingungen.

Viele Grüße
Christoph

 

\@Elmar:
Ich hab mir deinen Link mal zu Gemüte geführt.
Zum Thema Anzahl der Zeilen, kannst du mir beantworten ob leere Zeilen ebenfalls gezählt werden?
Und wie siehts mit 'Kommentar Zeilen aus?

Vielen Dank schonmal vorab

 

Soweit ich weiß zählt jede Zeile.
Da helfen wohl nur Unterfunktionen

 

Okay, vielen Dank Elmar
dann werde ich mich in den kommenden Tagen mal daran setzen den ganzen kram zu "straffen" bzw. auszulagern.

 

Hallo Christoph,
Auch ohne Auslagern, was wohl der bessere Weg ist, lässt sich aber im
vorhandenen Code schon so einiges an Zeichen und Zeilen sparen.
Anmerkung: ich habe nicht den ganzen Code Zeile für Zeile angeschaut.
1. es wird überwiegend auf das gleiche Formular zugegriffen "Form_PFLEGE_F9".
Da kannst du mit With Â… End With die hundertfach ausgeschriebene
Referenz schon mal weglassen.
2. diese Änderungen von ganzen Blöcken mit Steuerelementen lassen sich
z.T. sehr gut mit einer Schleife über alle Controls des Forms verkürzen.
gruss ekkehard

 

Hallo an alle drei Tip - Geber,

ich hab gerade angefangen das ganze zu zerpflücken.
Nur noch ein Verständnis Frage:
Wenn ich eine Function aufrufe, läd Access diese dann gleich komplett?
Dann würde auch ich verstehen was das teilen in Unter-Funktionen bringt.
Und, wenn man sein Projekt von den Usern mit dem Runtime Parameter nutzen lässt, gibt es da noch gesondert etwas zu beachten. Also verhält sich Access im Runtime Modus anders was z.B. Speicher angeht?

Grüße Christoph