Код зацикливания не перемещается по форме

Question

В моей базе данных есть форма, которая извлекает данные из запроса для еженедельного расчета необходимых деталей узла, и нажатием кнопки «завершить» необходимые компоненты должны быть перемещены в инвентарь и из него, но ничего не происходит когда кнопка завершена нажата. Код должен перебрать и переместить все части, но ничего не происходит.

Я прошел, чтобы увидеть, есть ли какие-либо ошибки, и исправил несколько синтаксических ошибок, но это все, что я сделал.

Private Sub Command96_Click()
    Dim ctl As Control
    Dim ctln
    Dim Qty As Double
    Dim db As DAO.Database
        Set db = CurrentDb
    Dim rs As DAO.Recordset
    For Each ctl In Me.Controls
        Select Case TypeName(ctl)
            Case "TextBox"
                Select Case ctl.ControlName
                    Case ctl Like "*Q"
                        ctln = Me.Controls(Right(ctl, Len(ctl) - 1))
                        If Not IsNull(DLookup("[In]", "[Inventory]", "[PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
                            num = DLookup("[In]", "[Inventory]", "[PartNum] = '" & ctln & "' AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "") + ctl
                        Else
                            num = ctl
                        End If
                        If Not IsNull(DLookup("[PartNum]", "[Inventory]", "[PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
                            CurrentDb.Execute "UPDATE [Inventory] " _
                                            & "SET [In] = " & num & " " _
                                            & "WHERE [PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "", dbFailOnError
                        Else
                            CurrentDb.Execute "INSERT INTO [Inventory] " _
                                            & "VALUES ('" & ctln & "'," & Me.YearNum & "," & Me.WeekNum & "," & num & ",0)", dbFailOnError
                        End If

                        num = 0

                        Set rs = db.OpenRecordset("SELECT UsedPartNum, (Quantity * " & ctl & ") AS Used FROM SubPartsUsed WHERE FinPartNum = '" & PartNum & "'", dbOpenDynaset)
                        If Not (rs.EOF And rs.BOF) Then
                            rs.MoveFirst
                            Do Until rs.EOF = True
                                If Not IsNull(DLookup("[Out]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
                                    num = DLookup("[Out]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "' AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "") + rs!Used
                                Else
                                    num = rs!Used
                                End If
                                If Not IsNull(DLookup("[PartNum]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
                                    CurrentDb.Execute "UPDATE [Inventory] " _
                                                    & "SET [Out] = " & num & " " _
                                                    & "WHERE [PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & ""
                                Else
                                    CurrentDb.Execute "INSERT INTO [Inventory] " _
                                                    & "VALUES ('" & rs!UsedPartNum & "'," & Me.YearNum & "," & Me.WeekNum & ",0," & num & ")"
                                End If
                                rs.MoveNext
                            Loop
                        End If
                        rs.Close
                        Set rs = Nothing
                End Select
        End Select

Я ожидаю, что детали будут внесены в инвентарь в виде комплектных узлов, а компоненты, из которых они изготовлены, должны быть удалены из инвентаря.

Answer 1

Нажимайте клавишу F9 снова и снова и снова, пока не увидите, в чем проблема. Кроме того, используйте «Добавить наблюдение», чтобы увидеть, какие значения передаются в какие переменные. Это должно очень помочь. Наконец, если это делает профессионал, почему вы используете: 'Command96_Click()'? Конечно, это не проблема, но и это не помогает.

Answer 2

Код выполняется высокопрофессиональным специалистом по VBA, существует множество ярлыков для выполнения кода. Новому программисту VBA может быть трудно исправить этот код, поэтому я думаю:

• первым шагом должно быть добавление Debug.Print code executed here at line number XXX для изучения того, какие строки выполняются, и выполняется ли их выполнение в предположении.

• После этого, если все в порядке с логикой кода, Debug.Print все операторы SQL, которые генерируются. Таким образом, вы можете проверить их правильность, выполнив в конструкторе запросов

например:.

Private Sub Command96_Click()
Dim ctl As Control
Dim ctln
Dim Qty As Double
Dim db As DAO.Database
    Set db = CurrentDb
Dim rs As DAO.Recordset
Dim sSQL As String
For Each ctl In Me.Controls
    Select Case TypeName(ctl)
        Debug.Pring "looping through controls"
        Case "TextBox"
            Select Case ctl.ControlName
                Case ctl Like "*Q"
                    Debug.Pring "Control with Q letter is found"
                    ctln = Me.Controls(Right(ctl, Len(ctl) - 1))
                    If Not IsNull(DLookup("[In]", "[Inventory]", "[PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
                        Debug.Print "Num is DLookuped"
                        num = DLookup("[In]", "[Inventory]", "[PartNum] = '" & ctln & "' AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "") + ctl
                    Else
                        num = ctl
                    End If
                    If Not IsNull(DLookup("[PartNum]", "[Inventory]", "[PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
                        Debug.Print "Executing Update Query for not null dlookup"
                        sSQL = "UPDATE [Inventory] " _
                                        & "SET [In] = " & num & " " _
                                        & "WHERE [PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & ""
                        Debug.Print sSQL
                        CurrentDb.Execute sSQL, dbFailOnError

                    Else
                        Debug.Print "Executing Update Query for null dlookup"
                        sSQL = "INSERT INTO [Inventory] " _
                                        & "VALUES ('" & ctln & "'," & Me.YearNum & "," & Me.WeekNum & "," & num & ",0)"
                        Debug.Print sSQL
                        CurrentDb.Execute sSQL, dbFailOnError
                    End If

                    num = 0

                    Set rs = db.OpenRecordset("SELECT UsedPartNum, (Quantity * " & ctl & ") AS Used FROM SubPartsUsed WHERE FinPartNum = '" & PartNum & "'", dbOpenDynaset)
                    If Not (rs.EOF And rs.BOF) Then
                        Debug.Print "Beginning action for each record in PartNum select query"
                        rs.MoveFirst
                        Do Until rs.EOF = True
                            If Not IsNull(DLookup("[Out]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
                                Debug.Print "Executing Dlookup for element in PartNum select query"
                                num = DLookup("[Out]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "' AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "") + rs!Used

                            Else
                                num = rs!Used
                            End If
                            If Not IsNull(DLookup("[PartNum]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
                                Debug.Print "Executing Update for not null DLookup element in PartNum select query"
                                sSQL = "UPDATE [Inventory] " _
                                                & "SET [Out] = " & num & " " _
                                                & "WHERE [PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & ""
                                Debug.Print sSQL
                                CurrentDb.Execute sSQL
                            Else
                                Debug.Print "Executing Update for  null DLookup element in PartNum select query"
                                sSQL = "INSERT INTO [Inventory] " _
                                                & "VALUES ('" & rs!UsedPartNum & "'," & Me.YearNum & "," & Me.WeekNum & ",0," & num & ")"
                                Debug.Print sSQL
                                CurrentDb.Execute sSQL
                            End If
                            rs.MoveNext
                        Loop
                    End If
                    rs.Close
                    Set rs = Nothing
            End Select
    End Select

В этом случае вам следует изучить свои окна Immediate (открывается по Ctrl + G), чтобы увидеть, каков план выполнения и какие тексты SQL генерируются, и проверить все из них.

В противном случае в этом коде слишком много логики, специфичной для вашего бизнеса, и понять поведение программы совершенно невозможно. Может быть, такое поведение предполагается из-за бизнес-логики? Много, много вопросов