Hallo,
mit folgendem Code möchte ich im UFO meines Forms einen Tarif aus der Tabelle TU_OFFERTE_TARIF_Positionen
ziehen.
Mein HF : TOUR_ERFASSUNG = Tbl_DT_ERFASSUNG
Mein UFO: TOUR_DT_ERFASSUNG_UFO = Tbl_DT_ERFASSUNG
Tarif Tabelle = TU_OFFERTE_TARIF_Positionen
Der Code soll im HF TOUR_ERFASSUNG ausgeführt werden.
Public Sub Tarif_Ziehen_Sammelgut()
If Me!TOUR_DT_ERFASSUNG_UFO .Form.Recordset.RecordCount > 0 Then
'------------------------------------------------------------------------------------------
Dim rs As DAO.Recordset
Set rs = Me!TOUR_DT_ERFASSUNG_UFO .Form.RecordsetClone
Do Until rs.EOF
rs.Edit
'---------------------------------------------
' TARIF ZIEHEN
'---------------------------------------------------------------------------------------------------
On Error GoTo myFehler
Dim strSQL As String
If IsNull(rs!ABG_Land) Or IsNull(rs!ABG_Plz) Or IsNull(rs!EMPF_Land) Or IsNull(rs!EMPF_Plz) Or rs!Frachtpfl_Gewicht = 0 Or IsNull(rs!TU_ID) Or rs!TU_OFFERTE = 0 Then
Exit Sub
End If
Set db = CurrentDb
strSQL = "SELECT a.LfdNr, a.Von_Land, a.Von_Plz, a.bis_Plz, a.nach_Land, a.PLZ1_von, a.PLZ1_Bis, a.TU_ID ,a.Kg1_von, a.Kg1_Bis, a.Tarif_Fix"
strSQL = strSQL & " FROM TU_OFFERTE_TARIF_Positionen AS a"
strSQL = strSQL & " WHERE a.Von_Land ='" & rs!ABG_Land & "'"
strSQL = strSQL & " And a.Nach_Land ='" & rs!EMPF_Land & "'"
strSQL = strSQL & " And " & Val(rs!ABG_Plz) & " between val(a.Von_Plz) And val(a.bis_Plz )"
strSQL = strSQL & " And " & Val(rs!EMPF_Plz) & " between val(a.PLZ1_von) And val(a.PLZ1_Bis )"
strSQL = strSQL & " And a.TU_ID =" & rs!TU_ID
strSQL = strSQL & " And " & rs!Frachtpfl_Gewicht & " between a.Kg1_von And a.Kg1_Bis "
Set rf = db.OpenRecordset(strSQL)
rs!TU_Fracht = rf!Tarif_Fix
rs!TU_Fracht = Round_New(rs!TU_Fracht, 0.01)
Set db = Nothing
Set rf = Nothing
Ende:
On Error Resume Next
Exit Sub
myFehler:
If Err.Number = 2113 Then
rs!TU_Fracht = 0
End If
Resume Ende
'--------------------------------------------
rs.Update
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End If
End Sub
Aber irgendwie passiert gar nix . An was kann das liegen bzw was mach ich falsch ?
Gruss
Bernie
Hallo,
haben wir da nicht schon mal dran herum gebastelt?
PS: mindestens hier:
If Me!TOUR_DT_ERFASSUNG_UFO .Form.Recordset.RecordCount > 0 Then
und
Set rs = Me!TOUR_DT_ERFASSUNG_UFO .Form.RecordsetClone
ist ein Fehler: Leerzeichen vor .Form
Nochmal korrigiert:
Public Sub Tarif_Ziehen_Sammelgut()
If Me!TOUR_DT_ERFASSUNG_UFO.Form.Recordset.RecordCount > 0 Then
'------------------------------------------------------------------------------------------
Dim rs As DAO.Recordset
Set rs = Me!TOUR_DT_ERFASSUNG_UFO.Form.RecordsetClone
Do Until rs.EOF
rs.Edit
'---------------------------------------------
' TARIF ZIEHEN
'---------------------------------------------------------------------------------------------------
On Error GoTo myFehler
Dim strSQL As String
If IsNull(rs!ABG_Land) Or IsNull(rs!ABG_Plz) Or IsNull(rs!EMPF_Land) Or IsNull(rs!EMPF_Plz) Or rs!Frachtpfl_Gewicht = 0 Or IsNull(rs!TU_ID) Or rs!TU_OFFERTE = 0 Then
Exit Sub
End If
Set db = CurrentDb
strSQL = "SELECT a.Tarif_Fix"
strSQL = strSQL & " FROM TU_OFFERTE_TARIF_Positionen AS a"
strSQL = strSQL & " WHERE a.Von_Land ='" & rs!ABG_Land & "'"
strSQL = strSQL & " And a.Nach_Land ='" & rs!EMPF_Land & "'"
strSQL = strSQL & " And " & Val(rs!ABG_Plz) & " between val(a.Von_Plz) And val(a.bis_Plz )"
strSQL = strSQL & " And " & Val(rs!EMPF_Plz) & " between val(a.PLZ1_von) And val(a.PLZ1_Bis )"
strSQL = strSQL & " And a.TU_ID =" & rs!TU_ID
strSQL = strSQL & " And " & rs!Frachtpfl_Gewicht & " between a.Kg1_von And a.Kg1_Bis "
rs!TU_Fracht =Round_New(db.OpenRecordset(strSQL)(0), 0.01)
rs.Update
Set db = Nothing
Set rf = Nothing
Ende:
On Error Resume Next
Exit Sub
myFehler:
If Err.Number = 2113 Then
rs!TU_Fracht = 0
End If
Resume Ende
'--------------------------------------------
rs.Update
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End If
End Sub
Hallo Franz,
ja haben wir.
Der Code wird auch direkt in einem anderen Form ausgeführt. Da funktioniert er aus 100 % richtig
Das is er
' TARIF ZIEHEN
'---------------------------------------------------------------------------------------------------
If Me.Tourenart = 3 Then
On Error GoTo myFehler
Dim strSQL As String
If IsNull(Me!ABG_Land) Or IsNull(Me!ABG_Plz) Or IsNull(Me!EMPF_Land) Or IsNull(Me!EMPF_Plz) Or Me.Frachtpfl_Gewicht = 0 Or IsNull(Me.TU_ID) Or Me.TU_OFFERTE = 0 Then
Exit Sub
End If
Set db = CurrentDb
strSQL = "SELECT a.LfdNr, a.Von_Land, a.Von_Plz, a.bis_Plz, a.nach_Land, a.PLZ1_von, a.PLZ1_Bis, a.TU_ID ,a.Kg1_von, a.Kg1_Bis, a.Tarif_Fix"
strSQL = strSQL & " FROM TU_OFFERTE_TARIF_Positionen AS a"
strSQL = strSQL & " WHERE a.Von_Land ='" & Me!ABG_Land & "'"
strSQL = strSQL & " And a.Nach_Land ='" & Me!EMPF_Land & "'"
strSQL = strSQL & " And " & Val(Me!ABG_Plz) & " between val(a.Von_Plz) And val(a.bis_Plz )"
strSQL = strSQL & " And " & Val(Me!EMPF_Plz) & " between val(a.PLZ1_von) And val(a.PLZ1_Bis )"
strSQL = strSQL & " And a.TU_ID =" & Me!TU_ID
strSQL = strSQL & " And " & Me!Frachtpfl_Gewicht & " between a.Kg1_von And a.Kg1_Bis "
Set rs = db.OpenRecordset(strSQL)
Me!TU_Fracht = rs!Tarif_Fix
Me!TU_Fracht = Round_New(Me!TU_Fracht, 0.01)
Set db = Nothing
Set rs = Nothing
Ende:
On Error Resume Next
Exit Sub
myFehler:
If Err.Number = 2113 Then
Me!TU_Fracht = 0
End If
Resume Ende
Aber dieser hier
funktioniert immer noch nicht. es kommt nicht mal eine Fehler-Meldung
Sorry er macht doch etwas.
Er bearbeitet aber leider nur den ersten Datensatz im UFO. Da findet er den richtigen Tarif.
Ich hab es durch sortierung überprüft.
Er führt anscheinend die Schleife nicht durch
Gruss
Bernie
Hallo,
naja, dann mußt Du halt selber debuggen...:
Setz einen Haltepunkt an den Prozeduranfang und fahre mit F8 im Einzelschritt durch.. Dabei kannst Du die Variableninhalte überprüfen.
PS:
es fehlt ja auch die Hälfte:
Do Until rs.EOF
rs.Edit
.
.
.
.
rs.Update
rs.Movenext
Loop
Sorry Franz ich hab mich da falsch ausgedrückt.
ich meinte den Code den du bearbeitet hatest.. da führt er die schleife nicht durch.
Er zieht nur den Tarif des ersten Datensatztes im UFO
Public Sub Tarif_Ziehen_Sammelgut()
If Me!TOUR_DT_ERFASSUNG_UFO.Form.Recordset.RecordCount > 0 Then
'------------------------------------------------------------------------------------------
Dim rs As DAO.Recordset
Set rs = Me!TOUR_DT_ERFASSUNG_UFO.Form.RecordsetClone
Do Until rs.EOF
rs.Edit
'---------------------------------------------
' TARIF ZIEHEN
'---------------------------------------------------------------------------------------------------
On Error GoTo myFehler
Dim strSQL As String
If IsNull(rs!ABG_Land) Or IsNull(rs!ABG_Plz) Or IsNull(rs!EMPF_Land) Or IsNull(rs!EMPF_Plz) Or rs!Frachtpfl_Gewicht = 0 Or IsNull(rs!TU_ID) Or rs!TU_OFFERTE = 0 Then
Exit Sub
End If
Set db = CurrentDb
strSQL = "SELECT a.Tarif_Fix"
strSQL = strSQL & " FROM TU_OFFERTE_TARIF_Positionen AS a"
strSQL = strSQL & " WHERE a.Von_Land ='" & rs!ABG_Land & "'"
strSQL = strSQL & " And a.Nach_Land ='" & rs!EMPF_Land & "'"
strSQL = strSQL & " And " & Val(rs!ABG_Plz) & " between val(a.Von_Plz) And val(a.bis_Plz )"
strSQL = strSQL & " And " & Val(rs!EMPF_Plz) & " between val(a.PLZ1_von) And val(a.PLZ1_Bis )"
strSQL = strSQL & " And a.TU_ID =" & rs!TU_ID
strSQL = strSQL & " And " & rs!Frachtpfl_Gewicht & " between a.Kg1_von And a.Kg1_Bis "
rs!TU_Fracht =Round_New(db.OpenRecordset(strSQL)(0), 0.01)
rs.Update
Set db = Nothing
Set rf = Nothing
Ende:
On Error Resume Next
Exit Sub
myFehler:
If Err.Number = 2113 Then
rs!TU_Fracht = 0
End If
Resume Ende
'--------------------------------------------
rs.Update
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End If
End Sub
na, darin fehlt auch der "fette" Code.....
??
warum steht doch drin
rs.Update
rs.Movenext
Loop
oder einfach nochmal einfügen ???
Hallo,
vielleicht hilft's wenn du die Sprungmarken deiner Fehlerbehandlung ans Ende der Prozedur stellst - direkt vor End Sub.
Gleich unterhalb des Prozedurkopfes schreibst du On Error GoTo myFehler.
In deiner Prozedur läuft die Verarbeitung nach rs.Update in diese Fehlerbehandlung - was sie ja nicht sollte ...
Ende:
On Error Resume Next
Exit Sub
...und steigt hier bei Exit Sub aus - beim ersten Durchlauf in der Schleife!
Wobei das 'On Error Resume Next' hier sinnlos ist, das die nächste Anweisung sowieso 'Exit Sub' lautet (das aber nur nebenbei)
Hallo Data & Franz,
also ich habs nun so hinbekommen.
Funktioniert auch.
Könnt Ihr beide dennoch mal drübersehen ob das so ok ist ?
Gruss
Bernie
Public Sub Tarif_Ziehen_Sammelgut()
If Me!TOUR_DT_ERFASSUNG_UFO.Form.Recordset.RecordCount > 0 Then
'------------------------------------------------------------------------------------------
Dim rs As DAO.Recordset
Set rs = Me!TOUR_DT_ERFASSUNG_UFO.Form.RecordsetClone
Do Until rs.EOF
rs.Edit
'---------------------------------------------
' TARIF ZIEHEN
'---------------------------------------------------------------------------------------------------
On Error GoTo myFehler
Dim strSQL As String
If IsNull(rs!ABG_Land) Or IsNull(rs!ABG_Plz) Or IsNull(rs!EMPF_Land) Or IsNull(rs!EMPF_Plz) Or rs!Frachtpfl_Gewicht = 0 Or IsNull(rs!TU_ID) Or rs!TU_OFFERTE = 0 Then
Exit Sub
End If
Set db = CurrentDb
strSQL = "SELECT a.Tarif_Fix"
strSQL = strSQL & " FROM TU_OFFERTE_TARIF_Positionen AS a"
strSQL = strSQL & " WHERE a.Von_Land ='" & rs!ABG_Land & "'"
strSQL = strSQL & " And a.Nach_Land ='" & rs!EMPF_Land & "'"
strSQL = strSQL & " And " & Val(rs!ABG_Plz) & " between val(a.Von_Plz) And val(a.bis_Plz )"
strSQL = strSQL & " And " & Val(rs!EMPF_Plz) & " between val(a.PLZ1_von) And val(a.PLZ1_Bis )"
strSQL = strSQL & " And a.TU_ID =" & rs!TU_ID
strSQL = strSQL & " And " & rs!Frachtpfl_Gewicht & " between a.Kg1_von And a.Kg1_Bis "
rs!TU_Fracht = Round_New(db.OpenRecordset(strSQL)(0), 0.01)
rs.Update
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
Set rs = Nothing
Ende:
On Error Resume Next
Exit Sub
myFehler:
If Err.Number = 2113 Then
rs!TU_Fracht = 0
End If
Resume Ende
End If
MsgBox " Alle Daten bearbeitet"
End Sub
Hallo,
ich habe deinen Code noch ein klein wenig umgestellt ...
Public Sub Tarif_Ziehen_Sammelgut()
On Error Goto MyFehler
Dim strSQL As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
If Me!TOUR_DT_ERFASSUNG_UFO.Form.Recordset.RecordCount > 0 Then
Set rs = Me!TOUR_DT_ERFASSUNG_UFO.Form.RecordsetClone
If IsNull(rs!ABG_Land) Or IsNull(rs!ABG_Plz) Or IsNull(rs!EMPF_Land) Or IsNull(rs!EMPF_Plz) Or rs!Frachtpfl_Gewicht = 0 Or IsNull(rs!TU_ID) Or rs!TU_OFFERTE = 0 Then
Set rs = Nothing
Exit Sub
Else
Do Until rs.EOF
rs.Edit
'TARIF ZIEHEN
Set db = CurrentDb
strSQL = "SELECT a.Tarif_Fix"
strSQL = strSQL & " FROM TU_OFFERTE_TARIF_Positionen AS a"
strSQL = strSQL & " WHERE a.Von_Land ='" & rs!ABG_Land & "'"
strSQL = strSQL & " And a.Nach_Land ='" & rs!EMPF_Land & "'"
strSQL = strSQL & " And " & Val(rs!ABG_Plz) & " between val(a.Von_Plz) And val(a.bis_Plz)"
strSQL = strSQL & " And " & Val(rs!EMPF_Plz) & " between val(a.PLZ1_von) And val(a.PLZ1_Bis)"
strSQL = strSQL & " And a.TU_ID =" & rs!TU_ID
strSQL = strSQL & " And " & rs!Frachtpfl_Gewicht & " between a.Kg1_von And a.Kg1_Bis"
rs!TU_Fracht = Round_New(db.OpenRecordset(strSQL)(0), 0.01)
rs.Update
rs.MoveNext
Loop
rs.Close
Set db = Nothing
Set rs = Nothing
MsgBox "Alle Daten bearbeitet"
End if
End If
Ende:
Exit Sub
myFehler:
If Err.Number = 2113 Then
rs!TU_Fracht = 0
End If
Resume Ende
End Sub
Solltest du die Objekt-Variable db als globale Variable an anderer Stelle deklariert haben, kann diese Zeile in obigem Code entfallen: 'Dim db As DAO.Database'
Ansonst hoffe ich, dass ich nichts übersehen habe ... versuch mal eine KOPIE dieses Codes in deiner DB auszuführen.
Grüße
Peter
Hallo Peter,
danke funktioniert prima
Gruss
bernie
Hallo Bernie,
freut mich!
Hoffe du kannst die Unterschiede erkennen und die Anpassungen auch in weiteren Codes verwenden, verwerten, anwenden ....
Viel Spaß noch
Peter
Hallo!
Ende:
Exit Sub
myFehler:
If Err.Number = 2113 Then
rs!TU_Fracht = 0
End If
Resume Ende
Das kommt mir etwas eigenartig vor. Was bringt es, wenn rs!TU_Fracht eingestellt wird, aber rs.Update nicht durchgeführt wird? Klappt das mit einem Formular-Recordset oder ist das Formular-Recordset eventuell ein ADODB-Rs?
Noch ein allgemeiner Tipp bezüglich Code: Das Unterteilen in mehrere Prozeduren könnte die Lesbarkeit aber vor allem die Wartbarkeit (Fehlersuche und Testen) erhöhen.
Beispiel:
Public Sub Tarif_Ziehen_Sammelgut()
Dim rs As DAO.Recordset
On Error Goto MyFehler
If Me!TOUR_DT_ERFASSUNG_UFO.Form.Recordset.RecordCount > 0 Then
Set rs = Me!TOUR_DT_ERFASSUNG_UFO.Form.RecordsetClone
If IsNull(rs!ABG_Land) Or IsNull(rs!ABG_Plz) Or IsNull(rs!EMPF_Land) Or IsNull(rs!EMPF_Plz) Or rs!Frachtpfl_Gewicht = 0 Or IsNull(rs!TU_ID) Or rs!TU_OFFERTE = 0 Then
Set rs = Nothing
Exit Sub
End if
Do Until rs.EOF
rs.Edit
rs!TU_Fracht = GetFixTarif(rs!ABG_Land, rs!EMPF_Land, rs!ABG_Plz, rs!EMPF_Plz, rs!TU_ID, rs!Frachtpfl_Gewicht)
rs.Update
rs.MoveNext
Loop
rs.Close ' Das würde ich nicht machen, da rs der Form.RecordsetClone ist und nicht selbst geöffnet wurde
Set rs = Nothing
MsgBox " Alle Daten bearbeitet"
End If
Ende:
Exit Sub
myFehler:
???
Resume Ende
End Sub
private Function GetFixTarif(ByVal Von_Land as String, ByVal Nach_Land As String, _
ByVal ABG_Plz as Long, ByVal EMPF_Plz as Long, _
ByVal TU_ID As Long, ByVal Frachtpfl_Gewicht as double) As Currency
dim strSQL as String
strSQL = "SELECT a.Tarif_Fix"
strSQL = strSQL & " FROM TU_OFFERTE_TARIF_Positionen AS a"
strSQL = strSQL & " WHERE a.Von_Land ='" & Von_Land & "'"
strSQL = strSQL & " And a.Nach_Land ='" & Nach_Land & "'"
strSQL = strSQL & " And " & ABG_Plz & " between val(a.Von_Plz) And val(a.bis_Plz )"
strSQL = strSQL & " And " & EMPF_Plz & " between val(a.PLZ1_von) And val(a.PLZ1_Bis )"
strSQL = strSQL & " And a.TU_ID =" & TU_ID
strSQL = strSQL & " And " & STR(Frachtpfl_Gewicht) & " between a.Kg1_von And a.Kg1_Bis "
'Anm.: Wozu dient Val(a.Von_Plz)?
GetFixTarif = Round_New(LookupSql(strSQL), 0.01)
end Function
private Function LookupSql(byval sSQL as String, Optional ByVal ValueIfNull As Variant = Null) as Variant
dim db as DAO.Database
dim rs as DAO.Recordset
Set db = CurrentDb
set rs = db.OpenRecordset(strSQL)
if not rs.EOF THEN
LookupSql = Nz(rs.Fields(0), ValueIfNull)
else
LookupSql = ValueIfNull
End if
rs.Close
End Function
mfg
Josef