Private Sub cmdAceptar_Click()
Dim dbName As String
Dim conn As ADODB.Connection
Dim strSelect As String
Dim strInsert As String
Dim FechaTrabajo As String
Dim FechaTrabajoSinFormato As String
Dim FechaMovimiento As String
Dim HoraMovimiento As String
Dim NumConfirmacion As String
Dim NumEmbarcacion As String
Dim Horario As String
Dim Servicio As String
Dim Usuario As String
Dim PaxAsignados As Integer
Dim CodigoGuia As String
Dim ActualizaEmbarcacion As String
Dim ActualizaHorario As String
Dim ActualizaGuia As String
Dim RolActual As String
Dim ActualHorarioParaCerrar As String
Dim HorarioEnTour As Boolean

'On Error GoTo Terminar:
    If ComboServicio.Text = "" Then
        MsgBox "Debe seleccionar un servicio"
        Exit Sub
    End If
    If ComboHorario.Text = "" Then
            MsgBox "Debe seleccionar un horario"
        Exit Sub
    End If
    
    Dia = Mid(txtFecha.Text, 4, 2)
    Mes = Left(txtFecha.Text, 2)
    Ao = Right(txtFecha.Text, 2)
La fecha de trabajo se requiere para insertar registros de status de
embarcaciones para la fecha y hora de trabajo. Esto si se desea insertar
un pago, con fecha atrasada, de manera de que se sepa cual fue el status
de las embarcaciones antes de que se cierre el tour de x fecha con z horario
    FechaTrabajo = Dia & "/" & Mes & "/" & Ao
    FechaTrabajoSinFormato = txtFecha.Text
    
    Servicio = ComboServicio.Text
    Horario = ComboHorario.Text
    Usuario = RsvUsuario
    FechaMovimiento = Format(Now, "dd/mm/yyyy")
    HoraMovimiento = Format(Now, "HH:mm:ss")
    
    dbName = frmMain.Ap_Path & frmMain.dbName
        Set conn = New ADODB.Connection
    conn.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & dbName & ";" & _
        "Persist Security Info=False"
    conn.Open
    
    strSelect = "Select Horarios.Horario, Horarios.EnTour From Horarios where Servicio = '" & Servicio & "' ORDER BY Horarios.Horario"
    If rcds.State = adStateOpen Then rcds.Close
    rcds.Open strSelect, db, adOpenStatic, adLockOptimistic
        rcds.MoveFirst
Checa cual es el horario para enviar a tour
    ActualHorarioParaCerrar = rcds.Fields(0)
    HorarioEnTour = rcds.Fields(1)
    
    If HorarioEnTour = True Then
        rcds.MoveNext
        For i = 2 To rcds.RecordCount
        HorarioEnTour = rcds.Fields(1)
        If HorarioEnTour = False Then
            ActualHorarioParaCerrar = rcds.Fields(0)
            Exit For
        End If
        rcds.MoveNext
        Next i
Si ya salieron todos los horarios de los tours, se sale de esta rutina
        If HorarioEnTour = True Then
            MsgBox "Ya salieron todos los tours del da"
            Exit Sub
        End If
    End If
    rcds.Close
    Solo si el horario que se desea cerrar es el que se debe cerrar, lo ejecuta
    If Horario = ActualHorarioParaCerrar Then
busca si hubo algn tour, status 7 (Gua Prximo tour), 9 (Prximo Tour)
    If DLookup("NumEmbarcacion", "Embarcaciones", "Servicio ='" & Servicio & "' And Status = 7") <> "No Encontrado" Then
        If DLookup("NumEmbarcacion", "Embarcaciones", "Servicio ='" & Servicio & "' And Status = 9") <> "No Encontrado" Then
Inserta en la tabla Embarcaciones Status Anteriores, con fecha y hora de tour
el status de cmo se encontraban las embarcaciones antes de salir al tour          
          conn.Execute ("Insert Into [Embarcaciones Status Anteriores] (FechaTour,HoraTour,NumEmbarcacion,Capacidad,Status,Ocupados,Libres,Guia,Servicio,TipoEmbarcacion) Select '" & FechaTrabajoSinFormato & "' As FechaTrabajo, '" & Horario & "' As Horario, NumEmbarcacion, Capacidad, Status, Ocupados, Libres, Guia, Servicio, TipoEmbarcacion FROM Embarcaciones WHERE Servicio = '" & Servicio & "'")
Inserta en la tabla Guias Rol Anteriores, con fecha y hora de tour, el status
en el que se encontraba los guas, antes de salir al tour
          conn.Execute ("Insert Into [Guias Rol Anteriores] (FecheTour,HoraTour,CodGuia,Nombre,Servicio,RolActual,EnTour) Select '" & FechaTrabajoSinFormato & "' As FechaTrabajo, '" & Horario & "' As Horario, CodGuia, Nombre, Servicio, RolActual, EnTour FROM Guias WHERE Servicio = '" & Servicio & "'")
Consulta que muestra los registros de la tabla Flujo Embarcaciones, donde
existi un cambio de status a 7 (Gua Prximo Tour)
           strSelect = "SELECT [Flujo Embarcaciones].Embarcacion, [Flujo Embarcaciones].NConfirmacion, Embarcaciones.Status, [Flujo Embarcaciones].CodGuia " & _
                "FROM ([Flujo Embarcaciones] INNER JOIN Reservaciones ON [Flujo Embarcaciones].NConfirmacion = Reservaciones.NConfirmacion) " & _
                "INNER JOIN Embarcaciones ON [Flujo Embarcaciones].Embarcacion = Embarcaciones.NumEmbarcacion " & _
                "Where (((Reservaciones.Fecha) = #" & FechaTrabajo & "#) And ((Reservaciones.Actividad) = '" & Servicio & "') And ((Reservaciones.Hora) = '" & Horario & "') And ((Embarcaciones.Status) = 7)) " & _
                "GROUP BY [Flujo Embarcaciones].Embarcacion, [Flujo Embarcaciones].NConfirmacion, Embarcaciones.Status, [Flujo Embarcaciones].CodGuia"
      
            rcds.Open strSelect, db, adOpenStatic, adLockOptimistic
        rcds.MoveFirst
            For i = 1 To rcds.RecordCount
            NumEmbarcacion = rcds.Fields(0)
            NumConfirmacion = rcds.Fields(1)
            CodigoGuia = rcds.Fields(3)
Actualiza la embarcacin a status 8 (Gua En tour)
            ActualizaEmbarcacion = "Update Embarcaciones set Status = 8 where NumEmbarcacion = " & NumEmbarcacion
            conn.Execute ActualizaEmbarcacion
Actualiza el Gua, como enviado a Tour
            ActualizaGuia = "Update Guias set EnTour = 1 where CodGuia = '" & CodigoGuia & "'"
            conn.Execute ActualizaGuia
Inserta en la tabla Flujo Embarcaciones las naves que pasaron a Status 8
            conn.Execute "Insert into [Flujo Embarcaciones] (Embarcacion,FechaStatus,HoraStatus,NConfirmacion,Status,CodGuia,Usuario) VALUES (" & NumEmbarcacion & ",'" & FechaMovimiento & "', '" & HoraMovimiento & "','" & NumConfirmacion & "',8,'" & CodigoGuia & "','" & Usuario & "')"
            rcds.MoveNext
            Next i
            rcds.Close
Consulta que muestra los registros de la tabla Flujo Embarcaciones, donde
existi un cambio de status a 9 (Prximo Tour)         
            strSelect = "SELECT [Flujo Embarcaciones].Embarcacion, [Flujo Embarcaciones].NConfirmacion, [Flujo Embarcaciones].PaxAsignados, Embarcaciones.Status, [Flujo Embarcaciones].CodGuia " & _
                "FROM ([Flujo Embarcaciones] INNER JOIN Reservaciones ON [Flujo Embarcaciones].NConfirmacion = Reservaciones.NConfirmacion) " & _
                "INNER JOIN Embarcaciones ON [Flujo Embarcaciones].Embarcacion = Embarcaciones.NumEmbarcacion " & _
                "Where (((Reservaciones.Fecha) = #" & FechaTrabajo & "#) And ((Reservaciones.Actividad) = '" & Servicio & "') And ((Reservaciones.Hora) = '" & Horario & "') And ((Embarcaciones.Status) = 9)) " & _
                "GROUP BY [Flujo Embarcaciones].Embarcacion, [Flujo Embarcaciones].NConfirmacion, [Flujo Embarcaciones].PaxAsignados, Embarcaciones.Status, [Flujo Embarcaciones].CodGuia"
      
            rcds.Open strSelect, db, adOpenStatic, adLockOptimistic
           rcds.MoveFirst
            For i = 1 To rcds.RecordCount
            NumEmbarcacion = rcds.Fields(0)
            NumConfirmacion = rcds.Fields(1)
            PaxAsignados = rcds.Fields(2)
            CodigoGuia = rcds.Fields(4)
Actualiza la embarcacin a status 10 (En tour)
            ActualizaEmbarcacion = "Update Embarcaciones set Status = 10 where NumEmbarcacion = " & NumEmbarcacion
            conn.Execute ActualizaEmbarcacion
Inserta en la tabla Flujo Embarcaciones las naves que pasaron a Status 10
            conn.Execute "Insert into [Flujo Embarcaciones] (Embarcacion,FechaStatus,HoraStatus,NConfirmacion,Status,PaxAsignados,CodGuia,Usuario) VALUES ('" & NumEmbarcacion & "','" & FechaMovimiento & "', '" & HoraMovimiento & "','" & NumConfirmacion & "',10," & PaxAsignados & ",'" & CodigoGuia & "','" & Usuario & "')"
            rcds.MoveNext
            Next i
            rcds.Close
            Actualiza el horario, pasando el valor del campo En Tour a
                    Verdadero
            ActualizaHorario = "Update Horarios Set EnTour = True where Servicio = '" & Servicio & "' AND Horario = '" & Horario & "'"
            conn.Execute ActualizaHorario
            Mueve el rol actual de los Guas que no estn en tour
		Si hay algn gua que no esta en Tour, realiza lo siguiente:
            If DLookup("CodGuia", "Guias", "Servicio = '" & Servicio & "' AND EnTour = False") <> "No Encontrado" Then
            strSelect = "Select CodGuia from Guias where Servicio = '" & Servicio & "' AND EnTour = False order by RolActual"
            rcds.Open strSelect, db, adOpenStatic, adLockOptimistic
            rcds.MoveFirst
            RolActual = 0
            For i = 1 To rcds.RecordCount
            CodigoGuia = rcds.Fields(0)
            RolActual = RolActual + 1
            ActualizaGuia = "Update Guias set RolActual = " & RolActual & " where CodGuia = '" & CodigoGuia & "'"
            conn.Execute ActualizaGuia
            rcds.MoveNext
            Next i
            rcds.Close
                A los guas que estn en tour, se les asigna un Rol Actual a partir
del ultimo al cual se le asigno en las lneas anteriores
            strSelect = "Select CodGuia from Guias where Servicio = '" & Servicio & "' AND EnTour = True order by RolActual"
            rcds.Open strSelect, db, adOpenStatic, adLockOptimistic
            rcds.MoveFirst
            RolActual = RolActual + 1
            For i = 1 To rcds.RecordCount
            CodigoGuia = rcds.Fields(0)
            ActualizaGuia = "Update Guias set RolActual = " & RolActual & " where CodGuia = '" & CodigoGuia & "'"
            conn.Execute ActualizaGuia
            RolActual = RolActual + 1
            rcds.MoveNext
            Next i
            rcds.Close
            Else
Si todos los guas estn en tour, entonces vuelve los regresa al rol inicial
            strSelect = "Select CodGuia from Guias where Servicio = '" & Servicio & "' AND EnTour = True order by Rol"
            rcds.Open strSelect, db, adOpenStatic, adLockOptimistic
            rcds.MoveFirst
            RolActual = 1
            For i = 1 To rcds.RecordCount
            CodigoGuia = rcds.Fields(0)
            ActualizaGuia = "Update Guias set RolActual = " & RolActual & " where CodGuia = '" & CodigoGuia & "'"
            conn.Execute ActualizaGuia
            RolActual = RolActual + 1
            rcds.MoveNext
            Next i
            rcds.Close
            End If
                  Si se escogi algn gua emergente (gua adicional), entonces:    
                    CodigoGuia = Left(ComboGuiaEmergente.Text, 4)
                    If CodigoGuia <> "" Then
                    NumEmbarcacion = DLookup("NumEmbarcacion", "Embarcaciones", "Guia =  '" & CodigoGuia & "' And Status = 6")
Actualiza la embarcacin a Status 11 (Gua Emergente)
                    ActualizaEmbarcacion = "Update Embarcaciones set Status = 11, Dao = 'GUIA EMERGENTE' where NumEmbarcacion = " & NumEmbarcacion
                    conn.Execute ActualizaEmbarcacion
Inserta en el flujo de embarcaciones el cambio de status realizado
                    conn.Execute "Insert into [Flujo Embarcaciones] (Embarcacion,FechaStatus,HoraStatus,NConfirmacion,Status,CodGuia,Usuario) VALUES (" & NumEmbarcacion & ",'" & FechaMovimiento & "', '" & HoraMovimiento & "','Ninguna & " ',11,'" & CodigoGuia & "','" & Usuario & "')"
                    End If
    Unload Me
Se imprime el reporte del rol actual de los Guas, para conocer quienes
saldrn en el prximo Tour.
    CrystalReport1.ReportFileName = frmMain.Ap_Hist & "Rol Guias Actual.rpt"
    CrystalReport1.DiscardSavedData = True
    CrystalReport1.PrintReport
    'frmBuscaReservacionAPagar.SetFocus
    Exit Sub
        Else
En el caso de alguna inconsistencia, hablar a Sistemas
            MsgBox "Hay Guas que estn a punto de salir, pero no hay embarcaciones asignadas a algn Tour, es una inconsistencia. Avisar a Sistemas"
            Exit Sub
        End If
    Else
En el caso de alguna inconsistencia, hablar a Sistemas
        If DLookup("NumEmbarcacion", "Embarcaciones", "Servicio ='" & Servicio & "' And Status = 9") <> "No Encontrado" Then
                MsgBox "Hay Embarcaciones Asignadas a punto de salir, pero hay Guas sin embarcacin asignada, es una inconsistencia. Avisar a Sistemas"
            Exit Sub
        Else
Si no hay ningn tour a la hora que se esta cerrando, actualizar nicamente
la tabla Horarios
        If MsgBox("No hay ningn tour a las " & Horario & " se proceder a cerrar dicha hora", vbOKCancel, "Establecer Horario en Tour") = vbOK Then
        ActualizaHorario = "Update Horarios Set EnTour = True where Servicio = '" & Servicio & "' AND Horario = '" & Horario & "'"
        conn.Execute ActualizaHorario
        Unload Me
        frmBuscaReservacionAPagar.SetFocus
        Exit Sub
        Else
        Exit Sub
        End If
        End If
    End If
    Else
     MsgBox "No es el horario que corresponde enviar al Tour"
     Exit Sub
    End If
Terminar:
    Unload Me
    frmBuscaReservacionAPagar.SetFocus
      Exit Sub
End Sub
