Foutmelding 3031

Status
Niet open voor verdere reacties.
M

Marthy Mc Fly

Gebruiker
Lid geworden
14 okt 2010
Berichten
117
Beste VBA experts,

Ik moet dagelijks met een onderhoudsprogram werken dat gebouwd is met een acces database. De persoon dit dit gebouwd heeft is onlangs ontslagen en nu zitten we natuurlijk met de gebakken peren.
Sinds een tijdje krijg ik de foutmelding 3031 (geen records found in recordset).
Hij brengt me daarbij in het volgend gedeelte van de code:
code vba.png

Is er iemand die een oplossing weet voor dit probleem?
 
Zet er eens een apostrof voor zodat het tekst wordt in de code en kijk of de code doorloopt.
Je doet toch niets met debug.print.
 
Fout 3021 tijdens uitvoering "Geen huidig Record"

Beste HSV,

Als ik doe wat je zegt dan geeft hij dezelfde fout maar dan is de volgende regel geel gemarkeerd.
Ik heb trouwens de verkeerde foutmelding vermeld in mijn vraag. Het gaat om fout 3021 ipv 3031
 
De foutmelding an sich is niet zo belangrijk; er zit weinig controle in de routine, en vermoedelijk komt dat doordat er geen check is of er überhaupt wel een record zit in de recordset. Je zou dat er eens bij kunnen zetten:
Code: 
    With rst3
        .MoveLast
        .MoveFirst
        If .RecordCount > 0 Then
             'Dan de rest van jouw code  
        End If
    End With
 
Nu krijg ik Fout 424 tijdens uitvoering: Object vereist
.MoveLast is bij deze geel gemarkeerd.
 
Laat je hele code eens zien, want ik heb te weinig tijd voor een middagje gokken :).
 
Code: 
Option Compare Database

Sub PMLauncher()

Dim rst1, rst2, rst3, rst4, rst5 As DAO.Recordset ' 1= PM WI list 2=pannebonnen 3=PMsequencehistory, 4=periodsperroute
Dim StrSQL1, StrSQL2, StrSQL3, StrSQL4, StrSQL5, StrSQL101, StrSQL102 As String
Dim Route, TB, Status, WODesc, FindStr1, FindStr2, Dept As String
Dim PMID, Sequence, NumberRoutePeriods, SequenceTimesMinPeriod, Period As Long
Dim CompletionDate As Date
Dim RoutePeriodsArray, PeriodSelector() As Variant
Dim TempQueryforAS400 As DAO.QueryDef

' Get Route definitions from sharepoint PM WI list ( no period )
           
    
        StrSQL1 = "SELECT DISTINCT Dept, Route, TijdensBedrijf " & _
                  "FROM [PM Work Instructions] " & _
                  "WHERE (((Periode) > 7)) " & _
                  "ORDER BY Route, TijdensBedrijf"
            
        Set rst1 = CurrentDb.OpenRecordset(StrSQL1, dbOpenDynaset)
        rst1.MoveFirst

' prepare PM Sequence List Recordset for save at end of sub
        StrSQL5 = "SELECT PMID, Route, TijdensBedrijf, Period, Sequence, WODesc, Machine, LaunchDate " & _
                   "FROM A_10_TBL_PM_Sequence_History"
                   
        Set rst5 = CurrentDb.OpenRecordset(StrSQL5, dbOpenDynaset)

' for each route definition (no period)
Do While Not rst1.EOF

    ' Find Last pannebon and its status for current Route & TB & Dept
    Dept = rst1("Dept")
    Route = rst1("Route")
    TB = rst1("Tijdensbedrijf")
        
    Debug.Print "BEGIN "; "Route : "; Route; " TB : "; TB
    'MsgBox "begin"

    ' Find Last pannebon with route desc and TB

StrSQL2 = "SELECT TOP 1 Bonnr, Machine, DeptCode, Status, Active, Orderbeschrijving, [Datum PE], [Datum P] " & _
          "FROM [TBL-SNS-ALLE-WO] " & _
          "WHERE (((Orderbeschrijving) Like 'AutoRoute : " & Route & " TijBedr : " & TB & "*')) " & _
          "ORDER BY [Datum P] DESC"
       
    Set rst2 = CurrentDb.OpenRecordset(StrSQL2, dbOpenDynaset)
    Debug.Print rst2.RecordCount
        'Mid([Orderbeschrijving];InStr([Orderbeschrijving];" Route : ")+9;(InStr([Orderbeschrijving];" TijBedr : ")-(InStr([Orderbeschrijving];" Route : ")+9)))="RC1"
        'Route = Mid(rst2("Orderbeschrijving"), InStr(rst2("Orderbeschrijving"), " Route : ") + 9, (InStr(rst2("Orderbeschrijving"), " TijBedr : ")) - (InStr(rst2("Orderbeschrijving"), " Route : ") + 9))
        ' PMID = CDbl(Trim(Mid(rst2("Orderbeschrijving"), (InStr(rst2("Orderbeschrijving"), "PMID : ") + 7), 4)))
         'TB = Mid(rst2("Orderbeschrijving"), (InStr(rst2("Orderbeschrijving"), " TijBedr : ") + 11), 2)
        
    ' if FindStr1 is null , no work order found, start with sequence 1
        If rst2.RecordCount = 0 Then
            Sequence = 1
            Debug.Print " No WO, start sequencing "
            CompletionDate = Now() - 4000 'set virtual completion date very long ago
     ' if WO completed, find last sequence in A_10_TBL_PM_Sequence_History, there has to be a sequence otherwhise WO was not existing ( NO MANUAL enter PM in AS400)
        ElseIf rst2("Status") = "PE" Or rst2("Status") = "AF" Then
            Debug.Print "WO completed, find next sequence"
            Status = rst2("Status")
            CompletionDate = rst2("Datum PE")
       
        
StrSQL3 = "SELECT TOP 1 Sequence, ID " & _
          "FROM A_10_TBL_PM_Sequence_History " & _
          "WHERE ((Route = '" & Route & "') And (TijdensBedrijf = '" & TB & "')) " & _
          "ORDER BY ID DESC"
            
        
            Set rst3 = CurrentDb.OpenRecordset(StrSQL3, dbOpenDynaset)
            Debug.Print rst3.RecordCount; "Bonnr : "; rst2("Bonnr"); " ID : "; rst3("ID")
            
            Sequence = rst3("Sequence")
            Sequence = Sequence + 1 'next sequence
            Debug.Print "Next Sequence : "; Sequence; "ID :"; rst3("ID")
            rst3.Close
            Set rst3 = Nothing
                     
        Else
            Debug.Print "WO not completed"; rst2("Status")
            GoTo NextPMDef 'WO is not completed, next Route Definition (no period)
            
        End If
        
        
        ' Find Next Sequence
            'first get all periods for route and TB out of PM tasklist in sharepoint ( period > 7 , this should be in TPM )
StrSQL4 = "SELECT Route, TijdensBedrijf, Periode, ID, Dept " & _
          "FROM [PM Work Instructions] " & _
          "WHERE (((Route)='" & Route & "') AND ((TijdensBedrijf)='" & TB & "') AND ((Periode)>7)) " & _
          "ORDER BY Periode"
        Set rst4 = CurrentDb.OpenRecordset(StrSQL4, dbOpenDynaset)
        RoutePeriodsArray = rst4.GetRows(20) ' element1 van 0 tot 2 = column, element2 van 0 tot aantal rows of periodes, 20 rows worden opgehaald (of minder)
        NumberRoutePeriods = UBound(RoutePeriodsArray, 2) ' vanaf 0 dus + 1 voor absuluut aantal
        
        Debug.Print "min Period : "; RoutePeriodsArray(2, 0); "Max Period : "; RoutePeriodsArray(2, (NumberRoutePeriods)); "nr periods : "; NumberRoutePeriods + 1
        
        ' Check if WO is Due for release
        If CompletionDate + RoutePeriodsArray(2, 0) > Now() Then 'skip , WO not yet Due for Release MOET NOG JUIST GEZET
            Debug.Print "Not Due, due on : "; (CompletionDate + RoutePeriodsArray(2, 0)); " now = "; Now()
            GoTo NextPMDef
        End If
        
        ' check if not over max sequence, else reset to 1
        If Sequence > (RoutePeriodsArray(2, (NumberRoutePeriods))) Then
            Sequence = 1
            Debug.Print " reset Sequence "
        End If
        Debug.Print " start build periodselector "
        'build periodselector array 'min period * sequence, then array  each period / min period * sequence integer, highest array integer selects "each period"
        SequenceTimesMinPeriod = Sequence * RoutePeriodsArray(2, 0)
        ReDim PeriodSelector(NumberRoutePeriods)
        ' populate RouteSelector
        For i = 0 To (NumberRoutePeriods)
            PeriodSelector(i) = SequenceTimesMinPeriod / RoutePeriodsArray(2, i)
            Debug.Print "periodeselector "; PeriodSelector(i)
        Next i
        'find highest integer
        For j = (NumberRoutePeriods) To 0 Step -1
            If Int(PeriodSelector(j)) = (PeriodSelector(j)) Then ' = integer
                Period = RoutePeriodsArray(2, j)
                Debug.Print "Selected Period : "; Period
                Exit For
            End If
        Next j
        ' find new PMID in PM WI list
        rst4.MoveFirst
        rst4.FindFirst "Periode =" & Period
        PMID = rst4("ID")
        Route = rst4("Route")
        TB = rst4("TijdensBedrijf")
        Periode = rst4("Periode")
        Dept = rst4("Dept")
        rst4.Close
        Set rst4 = Nothing
        ' compile WO Desc
        WODesc = "AutoRoute : " & Route & " TijBedr : " & TB & " Periode : " & Periode & " PMID : " & PMID & " Seqnr : " & Sequence & " => Preventieve WerkInstructie staan op Sharepoint met ID : " & PMID
        ' save to PM Sequence Hist Table
                
        rst5.AddNew
            rst5("PMID") = PMID
            rst5("Route") = Route
            rst5("TijdensBedrijf") = TB
            rst5("Period") = Periode
            rst5("Sequence") = Sequence
            rst5("WODesc") = WODesc
            rst5("Machine") = Dept
            rst5("LaunchDate") = Now()
        rst5.Update
        Debug.Print " EINDE "; " Route "; Route; TB; "New PMID : "; PMID
NextPMDef:

rst2.Close
Set rst2 = Nothing

rst1.MoveNext
Loop

' publish new Work orders out of PM history  as excell and set flag to published
 Debug.Print " publish CSV "
 StrSQL101 = "SELECT Machine, BadgeCode, Tiknr, Actief, WODesc " & _
            "FROM A_10_TBL_PM_Sequence_History " & _
            "WHERE (((LaunchedToExcell)=False))"

Set TempQueryforAS400 = CurrentDb.CreateQueryDef("TEMPQAS400", StrSQL101)
DoCmd.TransferText acExportDelim, "Export to AS400 Specification", "TEMPQAS400", "P:\PANNES.CSV"
CurrentDb.QueryDefs.Delete "TEMPQAS400"
Set TempQueryforAS400 = Nothing

' set launched flag in PM history table
Debug.Print " set launced Flags"
StrSQL102 = "UPDATE A_10_TBL_PM_Sequence_History SET LaunchedToExcell = True " & _
            "WHERE (((LaunchedToExcell)=False))"
DoCmd.RunSQL (StrSQL102)

EndSub:

' Close the recordsets

rst1.Close
rst5.Close
Set rst1 = Nothing
Set rst5 = Nothing
    
Debug.Print "KLAAR"

End Sub
Dit is de ganse code van deze module
 
Blijkbaar niet eenvoudig gezien de reacties. De werking van deze module gaan uitleggen is al
even complex als de codes inde module.
 
Ik zou de ontwikkelaar toch maar weer snel inschakelen.
 
Dat is geen opties meer. Deze persoon is bedankt voor bewezen diensten. En dat zat er al lang aan te komen.
Dus mogelijk gaat deze module herschreven moeten worden. Volgens mij zit er veel in wat niet nodig is.
Maar mijn kennis van vba is te beperkt om het zelf op te lossen.
 
Ik had er nog niet naar gekeken, dus ik kan je niet zeggen of het lastig is of niet. Zal dat zo even doen. Ik zie wél een paar idiote declaraties :).
 
Verbeter me als ik fout ben.
Als ik het goed begrijp loopt de code niet door omdat hij een record niet vindt in de recordset.
Er zou dus enkel een melding mogen komen als hij iets niet vindt, maar ook de optie om de code verder te zetten.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan