Usando Access

Inserir registros de horas com intervalos de 20 minutos

Adquira a assinatura vitalícia do site e passe a ter acesso aos arquivos exemplos, vídeos, revistas, livros e ao kit de montagem de ribbons. Você terá suporte por e-mail, caso necessite tirar dúvidas pontuais. Clique AQUI e veja como obter um dos nossos planos. Clique AQUI e faça uma visita a seção Downloads do site e verifique as centenas de arquivos que estará à sua disposição. Clique AQUI e faça uma visita a seção Vídeos do site e veja a lista que estará disponível ao se tornar o nosso assinante vitalício. Clique AQUI e saiba mais detalhes sobre o kit de montagem de ribbons (deixe seus aplicativos com aspecto profissional).

Usuário Regis:

Prezado,

tenho uma tabela TbMarcacaoConsultas com os campos HoraConsulta e DtaConsulta.

Tenho um Formulário aonde entro com os campos DtaConsulta, HoraInicial, HoraFinal e IntervaloMinutos.

Exemplo:

DtaConsulta = 28/08/2017
HoraInicial = 13:00
HoraFinal = 16:00
IntervaloMinutos = 20

Gostaria que fossem criados registros na Tabela TbMarcacaoConsultas.

13:00 28/08/2017
13:20 28/08/2017
13:40 28/08/2017
14:00 28/08/2017 até 16:00

Tenho um código abaixo, porém só está inserindo uma linha (faltam +9 linhas) a ser inseridas.

Dim HoraSeq As Date, MyStep As Integer
Set rstD = CurrentDb.OpenRecordset("Cadastro de Consultas")
MyStep = (DateDiff("n", Me.HoraInicial, Me.HoraFinal) / Me.Intervalo) + 1
With rstD
For HoraSeq = Me.HoraInicial To Me.HoraFinal Step MyStep
   dtReturn = DateAdd("n", Intervalo, Me.HoraInicial)
   .AddNew
      rstD!CRM = Me.CRMMedico
      rstD!DtadaConsulta = Me.DtEmissaoInicial
      rstD!HoradaConsulta = dtReturn
   .Update
Next
End With
Set rstD = Nothing
Me.Refresh

Como poderia acertar esse código? Teria como?

Suporte:

Regis, na parte em vermelho não seria HoraSeq ?

dtReturn = DateAdd("n", Intervalo, Me.HoraInicial)

Segue uma alternativa de código:

Dim horaAtual As Date
Dim rstD as DAO.Recordset
Set rstD = CurrentDb.OpenRecordset("Cadastro de Consultas")
With rstD
horaAtual = me!horaInicial
Do While Not me!horaFinal < horaAtual
       .AddNew
           rstD!CRM = Me.CRMMedico
           rstD!DtadaConsulta = Me.DtEmissaoInicial
           rstD!HoradaConsulta = horaAtual
      .Update
      horaAtual = DateAdd("n", me!intervalo, horaAtual)
Loop
End With
rstD.close
Set rstD = Nothing
Me.Refresh

Usuário Regis:

Prezado Avelino,

Você é SHOW !!! Utilizei o seu código alternativo.

Muito Grato, funcionou legal!

| Home | Vídeos | Tutoriais | Dicas | Ribbons | Suporte | Downloads | Contato | Artigo |