Ich hab den folgenden Code aber der ist nicht lauffähig.Die Abfrage läuft wenn man auf eine Schaltfläche anklickt aber dann bekomme ich die Meldung"Unzulässige SQL-Anweisung; 'DELETE', 'INSERT', 'SELECT' oder 'UPDATE' erwartet". Es gibt keine Syntax Fehler in Abfragen,soweit ich die Abfragen kontoliert habe. Brauche eure Hilfe
Code:
Function print_pfa(modus As Integer)
Dim conn1 As ADODB.Connection, Tab1 As ADODB.Recordset
Set conn1 = CurrentProject.Connection
Set Tab1 = New ADODB.Recordset
Dim crlf As String
Dim meldung As String
Dim criteria As String
Dim merker1 As Double
Dim merker2 As Double
Dim i As Integer
Dim docname As String
crlf = Chr(13) & Chr(10)
'On Error GoTo err_ppfa
'Prüfung der Anzahl Fehlerkataloge pro Prozeßschritt, Cancel der Kalkulation
'und Ausgabe des Hinweistextes
meldung = "In einem Prozeßschritt sind Fertigungsprozesse mit" & crlf
meldung = meldung & "unterschiedlichen Fehlerkatalogen aufgeführt. Dies" & crlf
meldung = meldung & "ist nicht zulässig. Unter einem Prozesschritt dürfen" & crlf
meldung = meldung & "nur Prozesse mit gleichen Fehlerkatalogen zusammen-" & crlf
meldung = meldung & "gefasst werden! Die Berechnung wird abgebrochen."
'Tab1.Open "FSK) PFA Prüfen Anz Fkat In PS 2 ", conn1, adOpenDynamic
Tab1.Open "[FSK) PFA Prüfen Anz Fkat In PS 2]", conn1, adOpenKeyset, adCmdTable
' Set Tab1 = DB1.OpenRecordset("FSK) PFA Prüfen Anz Fkat in PS 2", DB_OPEN_DYNASET)
merker1 = False
criteria = "[GP_NR]=" & Me!GP_NR
Tab1.MoveFirst
' FindFirst Implementation
Tab1.Find criteria, 0, adSearchForward
Do
If Tab1("AnzFKAT") > 1 Then merker1 = True
' FindNext Implementation
Tab1.Find criteria, 1, adSearchForward
Loop Until Tab1.EOF = True
Tab1.Close
If merker1 = True Then
merker1 = MsgBox(meldung, vbExclamation, "Berechnung abgebrochen")
Exit Function
End If
'FSK) DUMMY PFA Zusammenfassung 1 löschen und mit berechneten Daten neu füllen
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM [FSK) DUMMY PFA Zusammenfassung 1]"
DoCmd.RunSQL "DELETE * FROM [FSK) DUMMY PFA PS-Relvals]"
DoCmd.OpenQuery ("FSK) PFA Zusammenfassung 1 anfügen")
DoCmd.SetWarnings True
'Übertragung der Fehlernummer und des Fehlertextes vom Prozeßschritt auf
'die Felder für Gesamtprozeß (von PS_FNR auf GP_FNR und PS_FTXT auf GP_FTXT)
'Nur die Felder GP_FNR und GP_FTXT werden für die weitere Verarbeitung angewendet
Tab1.Open "FSK) DUMMY PFA Zusammenfassung 1 ", conn1, adOpenKeyset
' Set Tab1 = DB1.OpenRecordset("FSK) DUMMY PFA Zusammenfassung 1", DB_OPEN_DYNASET)
Tab1.MoveFirst
Do
' Tab1.Edit
Tab1("GP_FNR") = Tab1("PS_FNR")
Tab1("GP_FTXT") = Tab1("PS_FTXT")
Tab1.Update
Tab1.MoveNext
Loop Until Tab1.EOF
Tab1.Close
'Berechnung der Korrekturwerte für die Umrechnung der einzelnen rel. Fehleranteile vom
'Prozeßschritt auf den rel. Anteil in Bezug auf den Gesamtprozeß
DoCmd.SetWarnings False
DoCmd.OpenQuery ("FSK) PFA PS-relvals anfügen")
DoCmd.SetWarnings True
Set conn1 = CurrentProject.Connection
Tab1.Open "FSK) DUMMY PFA PS-Relvals ", conn1, adOpenDynamic, adLockOptimistic
' Set Tab1 = DB1.OpenRecordset("FSK) DUMMY PFA PS-Relvals", DB_OPEN_DYNASET)
Tab1.MoveFirst
' Tab1.Edit
Tab1("PS_KORRVAL") = 1
merker1 = 1
merker2 = Tab1("PS_REL_IO_GES")
Tab1.Update
Tab1.MoveNext
Do While Not Tab1.EOF
' Tab1.Edit
Tab1("PS_KORRVAL") = merker1 * merker2
merker1 = Tab1("PS_REL_IO_GES")
merker2 = Tab1("PS_KORRVAL")
Tab1.Update
Tab1.MoveNext
Loop
Tab1.Close
'Anwendung der Korrekturwerte auf die relwerte der Einzelfehler
DoCmd.SetWarnings False
DoCmd.OpenQuery ("FSK) PFA KORRVAL anwenden")
DoCmd.SetWarnings True
'Erzeugen der 0-Säulenwerte für die Darstellung eines Paretodiagrammes
Set conn1 = CurrentProject.Connection
Tab1.Open "FSK) PFA Source f gen 0-Säule ", conn1, adOpenDynamic, adLockOptimistic
' Set Tab1 = DB1.OpenRecordset("FSK) PFA Source f gen 0-Säule", DB_OPEN_DYNASET)
Tab1.MoveFirst
' Tab1.Edit
Tab1("0-Säule") = 0
merker1 = 0
merker2 = Tab1("GP_REL_NIO_EZF")
Tab1.Update
Tab1.MoveNext
Do
' Tab1.Edit
Tab1("0-Säule") = merker1 + merker2
merker1 = Tab1("0-Säule")
merker2 = Tab1("GP_REL_NIO_EZF")
Tab1.Update
Tab1.MoveNext
Loop Until Tab1.EOF
Tab1.Close
'Bericht anzeigen oder drucken
docname = "FSK) PFA Paretoanalyse Fehler aus Zeitraum"
If modus = True Then
For i = 1 To Me!anz_kopien
DoCmd.OpenReport docname, acViewDesign
DoCmd.OpenReport docname, A_NORMAL
Next i
Else
DoCmd.OpenReport docname, acViewDesign
DoCmd.OpenReport docname, A_PREVIEW
End If
exit_ppfa:
Exit Function
err_ppfa:
MsgBox Err & Error$
Resume exit_ppfa
End Function