Crear un bucle

   Tengo un Subformulario con datos de visitas y quisiera que al acabar un proceso, salte al siguiente registro del Subformulario y repita el proceso hasta el ultimo registro.
Adjunto codigo.

Muchas gracias por adelantado, saludos

Private Sub cmdCitaAOutlook_Click()

'Creem un control d'errors, per si de cas
On Error GoTo sol_err

'Cal assegurar-se que el registre està guardat. Per això el guardem
DoCmd.RunCommand acCmdSaveRecord

'Declaramos las variables que constituirán la base de la instancia de Outlook
Dim Olk As Outlook.Application

Dim OlkCita As Outlook.AppointmentItem
'Creem la instància d'Outlook

Set Olk = CreateObject("outlook.application")
Set OlkCita = Olk.CreateItem(olAppointmentItem)
'Anem afegint els elements de la cita

With OlkCita

.Start = Me.[Data visita].Value & " " & Me.[Hora de inici].Value
.Duration = Me.Duracio.Value
.Subject = Me.[Tipo Visita].Value & "     " & Me.Clientes_Nom_del_Client.Value & "    " & Me.Nom & "  " & Me.Cognom & "  " & Me.Telefono

'Si no tenim el camp amb notes a la cita podríem eliminar la línia següent
If Not IsNull(Me.[Descripció].Value) Then .Body = Me.[Descripció].Value
'Si no tenim el camp amb localització podríem eliminar la línia següent
If Not IsNull(Me.Clientes_CocatanearDireccio.Value) Then .Location = Me.Clientes_CocatanearDireccio.Value
'Si no tenim el camp que indica si volem recordatori o no podríem eliminar
'tot el bloc If ... endif següent ...
'De aquí....
If Me.Recordat.Value = True Then
'Si no s'haguessin especificat minuts els situem en cinc
If IsNull(Me.LapsoRecord.Value) Then
.ReminderMinutesBeforeStart = 5
Else
'Si no establim els minuts que hem determinat
.ReminderMinutesBeforeStart = Me.LapsoRecord.Value

'2 Per generar codi ens posem en la part en blanc al costat de l'esdeveniment que vulguem, i veurem com ens apareix un petit
'Botó de punts suspensius. Si fem clic sobre ell ens apareixerà una finestra. Li diem que volem generar codi.
'Se'ns obrirà l'editor de VB, amb dues línies per defecte (Private Sub ... i End Sub). Aquestes dues línies no han de tocar-se. El codi ho
'Escrivim entre aquestes línies

End If
.ReminderSet = True
End If
'Fins aquí ...
'Guardem la cita
.Save
End With
'Vam llançar un missatge de que tot ha anat bé
MsgBox "La cita s'ha guardat correctament", vbInformation, "OK"
'Eliminem la instància d'Outlook
Set Olk = Nothing
Salida:
Exit Sub
sol_err:
MsgBox "S'ha produït l'error" & Err.Number & " - " & Err.Description
Resume Salida

End Sub

Autor	Mensaje Tema Buscar Opciones del Tema Responder Crear un nuevo tema Versión imprimible Traducir Tema
MaccaM Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Nuevo Unido: 06/Octubre/2020 Localización: Barcelona Estado: Sin conexión Puntos: 11	Tema: Crear un bucle Enviado: 21/Octubre/2020 a las 21:00
	Tengo un Subformulario con datos de visitas y quisiera que al acabar un proceso, salte al siguiente registro del Subformulario y repita el proceso hasta el ultimo registro. Adjunto codigo. Muchas gracias por adelantado, saludos Private Sub cmdCitaAOutlook_Click() 'Creem un control d'errors, per si de cas On Error GoTo sol_err 'Cal assegurar-se que el registre està guardat. Per això el guardem DoCmd.RunCommand acCmdSaveRecord 'Declaramos las variables que constituirán la base de la instancia de Outlook Dim Olk As Outlook.Application Dim OlkCita As Outlook.AppointmentItem 'Creem la instància d'Outlook Set Olk = CreateObject("outlook.application") Set OlkCita = Olk.CreateItem(olAppointmentItem) 'Anem afegint els elements de la cita With OlkCita .Start = Me.[Data visita].Value & " " & Me.[Hora de inici].Value .Duration = Me.Duracio.Value .Subject = Me.[Tipo Visita].Value & " " & Me.Clientes_Nom_del_Client.Value & " " & Me.Nom & " " & Me.Cognom & " " & Me.Telefono 'Si no tenim el camp amb notes a la cita podríem eliminar la línia següent If Not IsNull(Me.[Descripció].Value) Then .Body = Me.[Descripció].Value 'Si no tenim el camp amb localització podríem eliminar la línia següent If Not IsNull(Me.Clientes_CocatanearDireccio.Value) Then .Location = Me.Clientes_CocatanearDireccio.Value 'Si no tenim el camp que indica si volem recordatori o no podríem eliminar 'tot el bloc If ... endif següent ... 'De aquí.... If Me.Recordat.Value = True Then 'Si no s'haguessin especificat minuts els situem en cinc If IsNull(Me.LapsoRecord.Value) Then .ReminderMinutesBeforeStart = 5 Else 'Si no establim els minuts que hem determinat .ReminderMinutesBeforeStart = Me.LapsoRecord.Value '2 Per generar codi ens posem en la part en blanc al costat de l'esdeveniment que vulguem, i veurem com ens apareix un petit 'Botó de punts suspensius. Si fem clic sobre ell ens apareixerà una finestra. Li diem que volem generar codi. 'Se'ns obrirà l'editor de VB, amb dues línies per defecte (Private Sub ... i End Sub). Aquestes dues línies no han de tocar-se. El codi ho 'Escrivim entre aquestes línies End If .ReminderSet = True End If 'Fins aquí ... 'Guardem la cita .Save End With 'Vam llançar un missatge de que tot ha anat bé MsgBox "La cita s'ha guardat correctament", vbInformation, "OK" 'Eliminem la instància d'Outlook Set Olk = Nothing Salida: Exit Sub sol_err: MsgBox "S'ha produït l'error" & Err.Number & " - " & Err.Description Resume Salida End Sub
	Muchas Gracias por su ayuda. Saludos

xavi Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Visite la página de los usuarios Añadir a la lista de amigos Administrador Terrassa-BCN Unido: 10/Mayo/2005 Localización: Catalunya \|\|\|\| Estado: Sin conexión Puntos: 14738	Enviado: 21/Octubre/2020 a las 22:25
	No me queda muy claro si ese es el código que quieres meter dentro del bucle ya que hay varias cosas que deberías cambiar para que fuera más eficiente. En cualquier caso, para recorrer los registros de un subformulario lo más adecuado es recorrer el RecordsetClone del mismo y lanzar el proceso en cada registro. El cambio es que, en lugar de Me! hay que utilizar el nombre del recordset. Aclara un poco más lo que haces y como lo haces para una respuesta más ajustada. Un saludo
	Xavi, un minyó de Terrassa Mi web