Повторяющиеся записи при запуске набора записей DAO - PullRequest
Новая
       31

Повторяющиеся записи при запуске набора записей DAO

0 голосов
/ 24 сентября 2018

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

Цель OpenRecMassUpdate - добавить «время окончания» ко всем неполным записям (те, у которых есть заказ)., время начала, но без времени окончания).Этот код используется в конце смены, поэтому все записи можно закрыть одним щелчком мыши.

После выполнения этой подпрограммы машины, которые были назначены заказу, теперь не имеют статуса.В результате мне потребовалась еще одна подпрограмма для добавления «незанятых» состояний на все эти машины.Это цель MassIdleUpdate.Он создает незанятую запись для каждой машины, которая ранее использовалась, и статус закрывается с помощью OpenRecMassUpdate.

Проблема, с которой я сталкиваюсь, заключается в том, что MassIdleUpdate создает несколько записей в случайное время.Когда я запустил анализ в базе данных, я нашел несколько записей, которые были созданы 3, 4 или более раз.

Option Compare Database

Dim dbsn As DAO.Database
Dim rstn As DAO.Recordset
Dim SQLqueryn As String
Dim recordcount As Integer
Dim tempstat As String
Dim stat1 As Integer

Public Sub OpenRecMassUpdate()

  On Error GoTo ErrorHandler

  recordcount = 1
  tempstat = "Idle"
  stat1 = 0
  Set dbsn = CurrentDb

  SQLqueryn = "SELECT * FROM kettleLog WHERE KettleStatus <> """ & tempstat & _
              """ And KettleLogic = " & stat1

  Set rstn = dbsn.OpenRecordset(SQLqueryn)
  With rstn
    If Not .BOF And Not .EOF Then
      .MoveLast
      .MoveFirst
      While (Not .EOF)
        .Edit
        .Fields("KettleFinish") = Now()
        .Fields("KettleLogic") = -1
        .Fields("EndOfShift") = 1
        .Update
        .MoveNext
        recordcount = recordcount + 1
      Wend
      MsgBox recordcount - 1 & " records were updated as a result of the end of the shift"
      recordcount = 1
    Else
    End If
    .Close
  End With

  dbsn.Close

ExitSub:
  Set dbsn = Nothing
  Set rstn = Nothing
  Exit Sub

ErrorHandler:
  MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
  Resume ExitSub

End Sub

Public Sub MassIdleUpdate()

  Dim tempKettle As String

  On Error GoTo ErrorHandler
  Set dbsn = CurrentDb

  SQLqueryn = "SELECT * FROM kettleLog WHERE EndOfShift = 1"

  Set rstn = dbsn.OpenRecordset(SQLqueryn)
  With rstn
    If Not .BOF And Not .EOF Then
      .MoveLast
      .MoveFirst
      For i = 1 To FindRecordCount(SQLqueryn)
        tempKettle = .Fields("Kettle")
        .Edit
        .Fields("EndOfShift") = 3
        .Update
        .AddNew
        .Fields("Kettle") = tempKettle
        .Fields("KettleStatus") = "Idle"
        .Fields("WorkOrder") = 0
        .Fields("KettleStart") = Now()
        .Fields("KettleLogic") = 0
        .Fields("EndOfShift") = 2
        .Update
        .MoveNext
      Next
    End If
    .Close
  End With

  tempKetlle = ""
  dbsn.Close
  i = 1

ExitSub:
  Set dbsn = Nothing
  Set rstn = Nothing

  Exit Sub

ErrorHandler:
  MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
  Resume ExitSub

End Sub

Ответы [ 2 ]

0 голосов
/ 25 сентября 2018

Спасибо @Freeman, который направил меня в правильном направлении.Вот мое решение проблемы, которая у меня была.Код был протестирован в моей песочнице с использованием различных сценариев, и он работает. 

Public Sub OpenRecMassUpdate1()

On Error GoTo ErrorHandler

Dim tempStat As String
tempStat = "Idle"
Dim stat1 As Long
stat1 = 0
Set dbsn = CurrentDb

Dim timeStamp As Date
timeStamp = Now()
SQLqueryn = "UPDATE KettleLog " & _
            "   SET KettleFinish = #" & timeStamp & "#, " & _
            "       KettleLogic = -1, " & _
            "       EndOfShift = 1 " & _
            " WHERE KettleStatus <> """ & tempStat & """" & _
            "   AND KettleLogic = 0"

dbsn.Execute SQLqueryn, dbFailOnError

SQLqueryn = "SELECT Count(*) " & _
            "AS RecCount " & _
            "  FROM KettleLog " & _
            " WHERE KettleLogic = -1 " & _
            "   AND EndOfShift = 1"

Set rstn = dbsn.OpenRecordset(SQLqueryn)

If Not rstn.BOF And Not rstn.EOF Then
Dim recordcount As Long
recordcount = rstn![RecCount]
End If

MsgBox recordcount & " records were updated as a result of the end of the shift"
rstn.Close
dbsn.Close

ExitSub:
Exit Sub

ErrorHandler:
MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
Resume ExitSub

End Sub

Public Sub MassIdleUpdate1()

On Error GoTo ErrorHandler

Dim TempKettle As String
Set dbsn = CurrentDb
SQLqueryn = "SELECT * " & _
            "  FROM KettleLog " & _
            "  WHERE EndOfShift = 1"

Set rstn = dbsn.OpenRecordset(SQLqueryn)
rstn.MoveLast
Dim rcrdcnt As Long
rcrdcnt = rstn.recordcount
ReDim machs(rcrdcnt) As String
'MsgBox rcrdcnt

rstn.MoveFirst
If Not rstn.BOF And Not rstn.EOF Then


For i = 0 To rcrdcnt - 1
machs(i) = rstn.Fields("Kettle")
rstn.MoveNext
Next
End If



SQLqueryn = "UPDATE KettleLog " & _
        " SET EndOfShift = 3 " & _
        " WHERE EndOfShift = 1 "

dbsn.Execute SQLqueryn, dbFailOnError

For j = 0 To rcrdcnt

SQLqueryn = "INSERT INTO KettleLog (Kettle, KettleStatus, WorkOrder, KettleStart, 
KettleLogic, EndOfShift) " & _
            " VALUES ( '" & machs(j) & "' , 'Idle', '0', #" & Now() & "#, '0', '2')"
MsgBox SQLqueryn
dbsn.Execute SQLqueryn, dbFailOnError

machs(j) = ""
Next
rstn.Close
dbsn.Close

ExitSub:
Exit Sub

ErrorHandler:
MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
Resume ExitSub
End Sub
0 голосов
/ 25 сентября 2018

Вместо того, чтобы перебирать все ваши записи, считая их и устанавливая значения по отдельности, делайте все это за один раз.СУБД (даже Access) предназначена для такого массового обновления. 

Public Sub OpenRecMassUpdate()

  On Error GoTo ErrorHandler

  Dim tempStat As String
  tempStat = "Idle"
  Dim stat1 As Long
  stat1 = 0
  Set dbsn = CurrentDb

  Dim timeStamp As Date
  timeStamp = Now()
  SQLqueryn = "UPDATE KettleLog " & _
              "   SET KettleFinish = #" & timeStamp & "#, " & _
              "       KettleLogic = -1, " & _
              "       EndOfShift = 1 " & _
              " WHERE KettleStatus <> """ & tempStat & """" & _
              "   AND KettleLogic = 0"

  Set rstn = dbsn.OpenRecordset(SQLqueryn)
  rstn.Close

  SQLqueryn = "SELECT Count(*) " & _
              "  FROM KettleFinish " & _
              " WHERE KettleFinish = #" & timeStamp & #", " & _
              "   AND KettleLogic = -1 " & _
              "   AND EndOfShift = 1"
  Set rstn = dbsn.OpenRecordset(SQLqueryn)
  If Not rstn.BOF And Not rstn.EOF Then
    rstn.MoveLast
    Dim recordcount As Long
    recordcount = rstn.recordcount
  End If
  MsgBox recordcount & " records were updated as a result of the end of the shift"
  rstn.Close
  dbsn.Close

ExitSub:
  Exit Sub

ErrorHandler:
  MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
  Resume ExitSub

End Sub

Примечание. Я привык использовать синтаксис ADO, а не DAO, поэтому может потребоваться небольшая настройка или два, но это должно помочь вам начать

Это будет делать то, что ваша OpenRecMassUpdate() процедура выполняла ровно в 2 SQL-запросах вместо этого трудоемкого цикла.

Вы также можете выполнитьТо же самое для Sub MassIdleUpdate().

На самом деле, при небольшом творческом потенциале вы, вероятно, могли бы объединить их в один, хотя их разделение снижает сложность, улучшает удобочитаемость и, следовательно, удобство обслуживания в будущем..

...