[Resolvido]Rotina criada por Alexandre Neves . Não funciona no Windows 8

Rotina Criada por Alexandre Neves

No Windows 7 não tinha problemas.
Obrigado Alexandre se puder dar uma vista de olhos..... erro a vermelho

Sub CriaTurnos()
'On Error Resume Next
Dim RstOperadores As DAO.Recordset, RstTurnos As DAO.Recordset, RstAusencias As DAO.Recordset
Dim dtData As Date, Inicio As Date, Fim As Date, Turno As Byte

Set RstOperadores = CurrentDb.OpenRecordset("SELECT * FROM Operadores;")
Set RstTurnos = CurrentDb.OpenRecordset("SELECT * FROM Turnos;")
Set RstAusencias = CurrentDb.OpenRecordset("SELECT Letra,Inicio,Fim FROM Ausencias LEFT JOIN Operadores ON Ausencias.Operador=Operadores.Nome;")
Inicio = Forms!Rotina!Inicio
Fim = Forms!Rotina!Fim

''''
CurrentDb.Execute "DELETE * FROM Turnos"
''''
For dtData = Inicio To Fim
RstTurnos.AddNew
RstTurnos(1) = dtData

RstAusencias.MoveFirst
Do While Not RstAusencias.EOF
If dtData >= RstAusencias("Inicio") And dtData <= RstAusencias("Fim") Then RstTurnos("Ausencia") = RstTurnos("Ausencia") & RstAusencias("Letra") & ","
RstAusencias.MoveNext
Loop
If Not IsNull(RstTurnos("Ausencia")) Then RstTurnos("Ausencia") = Mid(RstTurnos("Ausencia"), 1, Len(RstTurnos("Ausencia")) - 1)
For Turno = 1 To Forms!Rotina!NTurnos
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica1:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica1
End If

RstTurnos(Turno + 1) = RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica2:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica2
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "," & RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica3:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica3
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "," & RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica4:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica4
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "," & RstOperadores("Letra")
RstOperadores.MoveNext

Next

RstTurnos.Update

Next

RstTurnos.MoveFirst
Do While Not RstTurnos.EOF
RstOperadores.MoveFirst
RstTurnos.Edit
Do While Not RstOperadores.EOF

If InStr(1, RstTurnos(2) & RstTurnos(3) & RstTurnos(4) & RstTurnos("Ausencia"), RstOperadores("Letra")) = 0 Then
RstTurnos("Descanso") = RstTurnos("Descanso") & RstOperadores("Letra") & ","
End If

If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
Loop
If Right(RstTurnos("Descanso"), 1) = "," Then RstTurnos("Descanso") = Mid(RstTurnos("Descanso"), 1, Len(RstTurnos("Descanso")) - 1)
RstTurnos.Update
RstTurnos.MoveNext
Loop
Set RstTurnos = Nothing: Set RstOperadores = Nothing

End Sub

Boa tarde
Alexandre

Pode dar uma vista.

Obrigado

Boa noite, Assis
Se apenas não funciona no Windows8, terá a ver com alteração de codificação, que não conheço porque não tenho o Windows8

Boa noite

Alexadre
Desculpe voltar ao assunto.

Mas esta roda lindamente, repare na letra a azul é igual a que da erro.
A outra marca todos os dias.
Esta não marca nos feriados

Sub CriaTurnosF()
On Error Resume Next
Dim RstOperadores As DAO.Recordset, RstTurnos As DAO.Recordset, RstAusencias As DAO.Recordset
Dim dtData As Date, Inicio As Date, Fim As Date, Turno As Byte

Set RstOperadores = CurrentDb.OpenRecordset("SELECT * FROM Operadores;")
Set RstTurnos = CurrentDb.OpenRecordset("SELECT * FROM Turnos;")
Set RstAusencias = CurrentDb.OpenRecordset("SELECT Letra,Inicio,Fim FROM Ausencias LEFT JOIN Operadores ON Ausencias.Operador=Operadores.Nome;")
Inicio = Forms!Rotina!Inicio
Fim = Forms!Rotina!Fim

''''
CurrentDb.Execute "DELETE * FROM Turnos"
''''

For dtData = Inicio To Fim

If DCount("*", "Feriados", "DataFeriado=#" & Format(dtData, "mm-dd-yyyy") & "#") = 0 _
And Weekday(dtData) <> 1 And Weekday(dtData) <> 7 Then


RstTurnos.AddNew
RstTurnos(1) = dtData

RstAusencias.MoveFirst
Do While Not RstAusencias.EOF
If dtData >= RstAusencias("Inicio") And dtData <= RstAusencias("Fim") Then RstTurnos("Ausencia") = RstTurnos("Ausencia") & RstAusencias("Letra") & ","
RstAusencias.MoveNext
Loop
If Not IsNull(RstTurnos("Ausencia")) Then RstTurnos("Ausencia") = Mid(RstTurnos("Ausencia"), 1, Len(RstTurnos("Ausencia")) - 1)
For Turno = 1 To Forms!Rotina!NTurnos
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica1:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica1
End If

RstTurnos(Turno + 1) = RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica2:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica2
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "," & RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica3:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica3
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "," & RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica4:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica4
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "," & RstOperadores("Letra")
RstOperadores.MoveNext

Next
End If
RstTurnos.Update

Next

RstTurnos.MoveFirst
Do While Not RstTurnos.EOF
RstOperadores.MoveFirst
RstTurnos.Edit
Do While Not RstOperadores.EOF

If InStr(1, RstTurnos(2) & RstTurnos(3) & RstTurnos(4) & RstTurnos("Ausencia"), RstOperadores("Letra")) = 0 Then
RstTurnos("Descanso") = RstTurnos("Descanso") & RstOperadores("Letra") & ","
End If

If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
Loop
If Right(RstTurnos("Descanso"), 1) = "," Then RstTurnos("Descanso") = Mid(RstTurnos("Descanso"), 1, Len(RstTurnos("Descanso")) - 1)
RstTurnos.Update
RstTurnos.MoveNext
Loop
Set RstTurnos = Nothing: Set RstOperadores = Nothing

End Sub

Se o edit dá erro, apesar de achar estranho, será por não aceitar este método

Alexandre
O Erro é este

Será melhor reiniciar o computador. Pode ter ficado algum registo de anterior abertura da tabela.

Alexandre
Repare no erro

Uma estava assim
'On Error Resume Next


A outra assim
On Error Resume Next

Com o Win 7 nunca deu erro, com o 8 estava a dar.
Repare o que está antes do On a vermelho.

Obrigado amigo