[Resolvido]Ajuda na função inserção de datas pulando fins de semana

Gente a função que criei e para inserir datas pulando fins de semana legal, ela esta funcionando mais meia boca porque:
se coloco pra gerar 20 datas ela gera apenas 12 porque os fins de semana ela nao tras mais tambem nao gera

If (Me.Secoes > 0) Then 'Se valor do seçoes for <= 0
Dim db As Database, rs As Recordset
Dim I As Integer
Set db = CurrentDb()
Set rs = db.OpenRecordset("FisioHorario") 'Abre Fisiohorario
For I = 1 To Me.Secoes 'Insere as datas
rs.AddNew

rs("Horarios") = Me.Horario

rs("Numero_Secoes") = I
rs("Prontuario") = Me.Prontuario
rs("DataFisio") = DateAdd("D", I - 1, Date)

If Weekday(rs("DataFisio")) = vbSaturday Or Weekday(rs("DataFisio")) = vbSunday Then
rs.AddNew

End If

rs.Update


Next

rs.Close

db.Close

Olá Jou, seja bem vindo ao fórum!

Movido e titulo renomeado para facilitar a ferramenta de busca do fórum. A sala anterior destina-se a repositório de códigos, não a tratamento de dúvidas.

Aguarde ajuda nesta.

Boa noite, jou, e bem-vindo ao fórum

Será:
If (Me.Secoes > 0) Then 'Se valor do seçoes for <= 0
Dim db As Database, rs As Recordset
Dim I As Integer
Set db = CurrentDb()
Set rs = db.OpenRecordset("FisioHorario") 'Abre Fisiohorario
For I = 1 To Me.Secoes 'Insere as datas
rs.AddNew

rs("Horarios") = Me.Horario

rs("Numero_Secoes") = I
rs("Prontuario") = Me.Prontuario
rs("DataFisio") = DateAdd("D", I - 1, Date)

If Weekday(rs("DataFisio")) = vbSaturday Or Weekday(rs("DataFisio")) = vbSunday Then
rs.AddNew
Else
I=I-1
End If

rs.Update


Next

rs.Close

db.Close

Adicionalmente, criei aqui uma pequena função para inserção de datas, sem sábados e domingos, em uma caixa de texto. Se necessário, acredito que consigas adaptar tambem:

Dim N As Integer, D As Date

Me.Texto0 = Null
D = Date

Do While N < 20

If Format(D, "w") = 6 Then
    D = DateAdd("d", 3, D)
ElseIf Format(D, "w") = 7 Then
    D = DateAdd("d", 2, D)
Else
    D = DateAdd("d", 1, D)
End If

Me.Texto0 = Me.Texto0 & vbCrLf & D

N = N + 1

Loop

Você quer que sejam inseridas datas de segunda a sexta, certo? Para uma caixa de texto, a função que eu passei é funcional, e executando ela hoje, com 20 datas, retorna assim:

01 - 20/10/2011 - quinta-feira
02 - 21/10/2011 - sexta-feira
03 - 24/10/2011 - segunda-feira
04 - 25/10/2011 - terça-feira
05 - 26/10/2011 - quarta-feira
06 - 27/10/2011 - quinta-feira
07 - 28/10/2011 - sexta-feira
08 - 31/10/2011 - segunda-feira
09 - 01/11/2011 - terça-feira
10 - 02/11/2011 - quarta-feira
11 - 03/11/2011 - quinta-feira
12 - 04/11/2011 - sexta-feira
13 - 07/11/2011 - segunda-feira
14 - 08/11/2011 - terça-feira
15 - 09/11/2011 - quarta-feira
16 - 10/11/2011 - quinta-feira
17 - 11/11/2011 - sexta-feira
18 - 14/11/2011 - segunda-feira
19 - 15/11/2011 - terça-feira
20 - 16/11/2011 - quarta-feira

Como você fez a implementação no seu código?

Jou, já editei sua mensagem.

Amigo, escrever totalmente em maiúsculas não é permitido.

É bom que leia as regras do fórum, para se adequar ao grupo.

ok dilson deixa comigo
e criquio na verdade não e em um caixa de texto e sim em um subformulário que as datas são inseridas. mesmo assim vou dar uma olhada nesta sua função

Olá

tente assim:

Código:

If (Me.Secoes > 0) Then 'Se valor do seçoes for <= 0
Dim db As Database, rs As Recordset
Dim I As Integer
Set db = CurrentDb()
Set rs = db.OpenRecordset("FisioHorario") 'Abre Fisiohorario
I = 0
Do while I <= me.secoes
  If Weekday(rs("DataFisio")) <> vbSaturday AND Weekday(rs("DataFisio")) <> vbSunday Then
    rs.AddNew
      rs("Horarios") = Me.Horario
      rs("Numero_Secoes") = I
      rs("Prontuario") = Me.Prontuario
      rs("DataFisio") = DateAdd("D", I , Date)
    rs.Update
    I = I + 1
  End If
Loop
rs.Close
db.Close

Sucesso!

Resolveu? Agradeço retorno, pois terei que encerrar o tópico.

Como não houve retorno, o tópico passa a resolvido. Qualquer coisa reabra, por favor.

Como estou meio sem tempo mas realmente minha solução nao foi encontrada agradeço todos ai valeu

Como não houve retorno, o tópico passa a resolvido. Qualquer coisa reabra, por favor.