Private Sub MarcarBoxes()
Dim rst As Recordset, rstB As Recordset
Dim De As Date, Ds As Date, Box As Integer
'Remover o número de Box de todos os registos
CurrentDb.Execute "UPDATE ADMISSOES SET Box=NULL"
'a ordem na pesquisa é importante
Set rst = CurrentDb.OpenRecordset("SELECT * FROM ADMISSOES ORDER BY [DIA DE ADMISSÃO],[HORA DE ADMISSÃO]")
If rst.EOF Then Exit Sub
rst.MoveFirst
Do Until rst.EOF
'mostrar o progresso na Janela 'Immediate' (menu ver)
Debug.Print rst!ID ' ou quaisquer outros dados
DoEvents
'o calculo de data hora seria facilitado se estivesse num unico registo
De = DateValue(rst("[DIA DE ADMISSÃO]")) + TimeValue(rst("[HORA DE ADMISSÃO]"))
Ds = DateValue(rst("[DIA DE SAIDA]")) + TimeValue(rst("[HORA DE SAIDA]"))
If IsNull(rst!Box) Then
Box = 1
rst.Edit
rst!Box = 1
rst.Update
Else
Box = rst!Box
End If
'pesquisar outros registos que tenham a data hora de admissão dentro do intervalo desta ocupação
Set rstB = CurrentDb.OpenRecordset("SELECT * FROM ADMISSOES WHERE ID<>" & rst!ID & " AND " _
& "([DIA DE ADMISSÃO]+[HORA DE ADMISSÃO]) BETWEEN #" & Format(De, "yyyy-mm-dd hh:nn") _
& "# AND #" & Format(Ds, "yyyy-mm-dd hh:nn") & "#")
Do Until rstB.EOF
'o perido de ocupação simultânea será o compreendido entre a data hora de admissão deste registo
'e Ds ( Data de saída do registo anterior)
' Podes guardar numa tabela propria para o caso de os periodos de ocupação simultanea serem importantes
'será guardado o número da box 2+ para as ocupações simultaneas, so para titulo de exemplo
' o campo Box terá de ser adicionado à tabela Admissoes
Box = Box + 1
rstB.Edit
rstB!Box = Box
rstB.Update
rstB.MoveNext
Loop
rst.MoveNext
Loop
MsgBox "Terminado"
End Sub
