Neuigkeiten:

Ist euer Problem gelöst, dann bitte den Knopf "Thema gelöst" drücken!

Mobiles Hauptmenü

DAO.Recordset

Begonnen von Bernie110, Dezember 05, 2010, 12:12:26

⏪ vorheriges - nächstes ⏩
Drucken
Nach unten Seiten1
Benutzer-Aktionen

Bernie110

Dezember 05, 2010, 12:12:26
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.


Code [Auswählen]
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

DF6GL

#1
Dezember 05, 2010, 12:21:18 Letzte Bearbeitung: Dezember 05, 2010, 12:32:00 von DF6GL
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

Bernie110

#2
Dezember 05, 2010, 13:07:16
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

Code [Auswählen]
' 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

Bernie110

#3
Dezember 05, 2010, 13:21:22
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

DF6GL

#4
Dezember 05, 2010, 13:22:38
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

Bernie110

#5
Dezember 05, 2010, 13:28:31
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

Bernie110

#7
Dezember 05, 2010, 13:36:57
??

warum steht doch drin

      rs.Update

     rs.Movenext
     Loop

oder einfach nochmal einfügen ???

database

#8
Dezember 05, 2010, 13:53:15 Letzte Bearbeitung: Dezember 05, 2010, 14:14:06 von database
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 ...  

Code [Auswählen]

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)

Bernie110

#9
Dezember 05, 2010, 16:39:07
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

Code [Auswählen]
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

database

#10
Dezember 05, 2010, 18:46:34 Letzte Bearbeitung: Dezember 05, 2010, 19:36:49 von database
Hallo,

ich habe deinen Code noch ein klein wenig umgestellt ...
Code [Auswählen]

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

Bernie110

#11
Dezember 05, 2010, 19:37:16
Hallo Peter,

danke funktioniert prima

Gruss
bernie

database

#12
Dezember 05, 2010, 19:39:22
Hallo Bernie,

freut mich!

Hoffe du kannst die Unterschiede erkennen und die Anpassungen auch in weiteren Codes verwenden, verwerten, anwenden ....

Viel Spaß noch
Peter

Josef P.

#13
Dezember 05, 2010, 19:55:43 Letzte Bearbeitung: Dezember 05, 2010, 20:12:57 von Josef P.
Hallo!

Code (vb) [Auswählen]
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:
Code (vb) [Auswählen]
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
Drucken
Nach oben Seiten1
Benutzer-Aktionen