Attribute VB_Name = "Funciones"
Option Explicit
'Declaración de funciones públicas

'--Sleep--
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'--
'--SetWindowPos - Splash--
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
  
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'--

'--Ordenar Columnas de la Lista--
Public Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'--

'--Esperar q termine
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Public Const SYNCHRONIZE = &H100000
Public Const INFINITE = &HFFFFFFFF
'--

'--Cerrar Aplicacion
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const WM_CLOSE = &H10
'--

'--Mover Archivo
Public Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
'--

'--Cabecera Impresion
Public sCabecera() As String

'--Variables para el canje de puntos
Public lReglaImporteMaximo As Long
Public lReglaPuntoImporte  As Long
Public lReglaPuntoCantidad  As Long

'--VARIABLE PARA CAPTURAR FECHA SISTEMA DE LA BD REMOTA
Dim sFecha As String

Public Function ValidarRuta(sRuta, sMensaje As String, Optional EnviarMensajeError As Boolean = True) As Boolean

  'Valida q la ruta especificada exista
  
  ValidarRuta = False
  
  On Error GoTo LineaError
  
  If Dir(Trim(sRuta)) = "" Then
    If EnviarMensajeError = True Then
        MsgBox sMensaje, vbOKOnly + vbInformation
    End If
    Exit Function
  End If
    
  ValidarRuta = True
  
  Exit Function
  
LineaError:
  MsgBox "Ruta no existe: " + sRuta, vbOKOnly + vbInformation
End Function

Public Function LeerCampo(vCampo As Variant) As String

  'Si el campo se encuentra vacío o es nulo asignarle una cadena en blanco
  'Sino eliminar espacios a a derecha y a la izquierda
  
  On Error GoTo LineaError
      
  Select Case VarType(vCampo)
  Case vbEmpty, vbNull
    LeerCampo = ""
  Case Else
    LeerCampo = Trim$(vCampo)
  End Select
  
  Exit Function
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Function

Public Function VBsprintf(InString As String, ParamArray aInValues()) As String

  'Cambiar caracter $ x los parámetros
  
  On Error GoTo LineaError

  Dim OutString As String
  Dim ThisChar As String
  Dim IndexString As Integer
  Dim IndexValues As Integer
    
  OutString = ""
  IndexValues = 0
    
  For IndexString = 1 To Len(InString)
    
    ThisChar = Mid(InString, IndexString, 1)
        
    If ThisChar <> "$" Then
      OutString = OutString + ThisChar
    Else
    
      If IsNull(aInValues(IndexValues)) Then
        
        ' Quitamos CONVERT(DATETIME)
        If Mid(InString, IndexString - 18, 18) = "CONVERT(DATETIME,'" And _
        Mid(InString, IndexString + 1, 2) = "')" Then
             
          IndexString = IndexString + 2
          OutString = Mid(OutString, 1, Len(OutString) - 18)
        
        ' Quitamos los apostrofes - '$'
        ElseIf Mid(InString, IndexString - 1, 1) = "'" And _
        Mid(InString, IndexString + 1, 1) = "'" Then
             
          IndexString = IndexString + 1
          OutString = Mid(OutString, 1, Len(OutString) - 1)
                  
        End If
            
        ' Insertamos la palabra Null
        OutString = OutString + "Null"
      Else
            
        OutString = OutString + Trim(CStr(aInValues(IndexValues)))
      
      End If
          
      ' Incrementamos el indice
      IndexValues = IndexValues + 1
    
    End If
  
  Next
    
  VBsprintf = OutString
  
  Exit Function
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Function

Public Sub APISort(lvwList As ListView, _
                   intColumnHeaderIndex As Integer, _
                   Optional bytSortType As Byte)
  
  'Ordenar registros de la lista x columna seleccionada
  
  Screen.MousePointer = vbHourglass
  
  gblnOrder = Not gblnOrder
  lvwList.SortKey = intColumnHeaderIndex - 1
  
  Select Case bytSortType
  Case gbytLVW_SORT_DEFAULT
    'Use default sorting to sort the items in the list
    lvwList.SortOrder = Abs(gblnOrder) 'Abs(Not ListView1.SortOrder = 1)
    lvwList.Sorted = True
    
  Case gbytLVW_SORT_DATE
    'Use sort routine to sort by date
     lvwList.Sorted = False
     ' Es importante esta variable por que lo usamos en ListView_GetItemDate
     glngSubItem = intColumnHeaderIndex - 1
     SendMessageLong lvwList.hwnd, _
                     LVM_SORTITEMS, _
                     lvwList.hwnd, _
                     AddressOf CompareDates
              
  Case gbytLVW_SORT_VALUE
    'Use sort routine to sort by value
    lvwList.Sorted = False
    glngSubItem = intColumnHeaderIndex - 1
    SendMessageLong lvwList.hwnd, _
                    LVM_SORTITEMS, _
                    lvwList.hwnd, _
                    AddressOf CompareValues
  End Select
  
  ' Reestablecemos el puntero del mouse
  Screen.MousePointer = vbDefault
  
End Sub

Public Function CompareDates(ByVal lParam1 As Long, _
                             ByVal lParam2 As Long, _
                             ByVal hwnd As Long) As Long
     
  'CompareDates: This is the sorting routine that gets passed to the
  'ListView control to provide the comparison test for date values.
  
  'Compare returns:
  ' 0 = Less Than
  ' 1 = Equal
  ' 2 = Greater Than
  
  Dim dDate1 As Date
  Dim dDate2 As Date
    
  'Obtain the item names and dates corresponding to the
  'input parameters
  dDate1 = ListView_GetItemDate(lParam1, hwnd)
  dDate2 = ListView_GetItemDate(lParam2, hwnd)
    
  'based on the Public variable gblnOrder set in the
  'columnheader click sub, sort the dates appropriately:
  Select Case gblnOrder
  Case True:    'sort descending
        
    If dDate1 < dDate2 Then
      CompareDates = 0
    ElseIf dDate1 = dDate2 Then
      CompareDates = 1
    Else: CompareDates = 2
    End If
  
  Case Else: 'sort ascending
  
    If dDate1 > dDate2 Then
      CompareDates = 0
    ElseIf dDate1 = dDate2 Then
      CompareDates = 1
    Else: CompareDates = 2
    End If
  
  End Select

End Function

Public Function CompareValues(ByVal lParam1 As Long, _
                              ByVal lParam2 As Long, _
                              ByVal hwnd As Long) As Long
     
  'CompareValues: This is the sorting routine that gets passed to the
  'ListView control to provide the comparison test for numeric values.
  
  'Compare returns:
  ' 0 = Less Than
  ' 1 = Equal
  ' 2 = Greater Than
  
  Dim val1 As Double
  Dim val2 As Double
    
  'Obtain the item names and values corresponding
  'to the input parameters
  val1 = ListView_GetItemValueStr(hwnd, lParam1)
  val2 = ListView_GetItemValueStr(hwnd, lParam2)
    
  'based on the Public variable gblnOrder set in the
  'columnheader click sub, sort the values appropriately:
  Select Case gblnOrder
    Case True:    'sort descending
         
      If val1 < val2 Then
        CompareValues = 0
      ElseIf val1 = val2 Then
        CompareValues = 1
      Else: CompareValues = 2
      End If
   
    Case Else: 'sort ascending
   
      If val1 > val2 Then
        CompareValues = 0
      ElseIf val1 = val2 Then
        CompareValues = 1
      Else: CompareValues = 2
      End If
  
  End Select

End Function

Public Function ListView_GetItemDate(lParam As Long, _
                                     hwnd As Long) As Date
  
  Dim r As Long
  Dim hIndex As Long
   
  'Convert the input parameter to an index in the list view
  objFind.flags = LVFI_PARAM
  objFind.lParam = lParam
  hIndex = SendMessageAny(hwnd, LVM_FINDITEM, -1, objFind)
   
  'Obtain the value of the specified list view item.
  'The objItem.iSubItem member is set to the index
  'of the column that is being retrieved.
  objItem.mask = LVIF_TEXT
  objItem.iSubItem = glngSubItem
  objItem.pszText = Space$(32)
  objItem.cchTextMax = Len(objItem.pszText)
   
  'get the string at subitem 1
  r = SendMessageAny(hwnd, LVM_GETITEMTEXT, hIndex, objItem)
   
  'and convert it into a date and exit
  If r > 0 Then
   ListView_GetItemDate = CDate(Left$(objItem.pszText, r))
  End If
  
End Function
  
Public Function ListView_GetItemValueStr(hwnd As Long, lParam As Long) As Double
  
  Dim r As Long
  Dim hIndex As Long
    
  'Convert the input parameter to an index in the list view
  objFind.flags = LVFI_PARAM
  objFind.lParam = lParam
  hIndex = SendMessageAny(hwnd, LVM_FINDITEM, -1, objFind)
    
  'and convert it into a long
  If r > 0 Then
    ListView_GetItemValueStr = CDbl(Left$(objItem.pszText, r))
  End If
  
End Function

Public Sub ValidKeyPress(ByRef KeyAscii As Integer, ParamArray aOptions())

  'Validar tecla digitada
  
  On Error GoTo LineaError
    
  Dim iNOptions As Integer
  Dim iOption As Integer
  
  Dim iStart As Integer
  
  iNOptions = UBound(aOptions)
  iStart = LBound(aOptions)
  
  For iOption = iStart To iNOptions

    Select Case aOptions(iOption)
    Case kVKP_ALPHA_ONLY
      
      KeyAscii = IIf( _
          (KeyAscii >= 65 And KeyAscii <= 90) Or _
          (KeyAscii >= 97 And KeyAscii <= 122) Or _
          (KeyAscii = 46) Or _
          (InStr("ÑñáéíóúÁÉÍÓÚ " + Chr(8), Chr(KeyAscii)) <> 0), _
          KeyAscii, 0)
        
    Case kVKP_NUMERIC_ONLY
    
      KeyAscii = IIf( _
          (KeyAscii >= 48 And KeyAscii <= 57) Or _
          (KeyAscii = 46) Or _
          (KeyAscii = 8 Or KeyAscii = 32), _
          KeyAscii, 0)
          
    Case kVKP_NUMERIC_INTEGER_ONLY
    
      KeyAscii = IIf( _
          (KeyAscii >= 48 And KeyAscii <= 57) Or _
          (KeyAscii = 8 Or KeyAscii = 32), _
          KeyAscii, 0)
    
    Case kVKP_UPPER_CASE
    
      KeyAscii = Asc(UCase(Chr(KeyAscii)))
    
    Case kVKP_LOWER_CASE
    
      KeyAscii = Asc(LCase(Chr(KeyAscii)))
        
    End Select
    
  Next
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub
Public Sub ValidKeyPressNom(ByRef KeyAscii As Integer, ParamArray aOptions())

  'Validar tecla digitada
 
  On Error GoTo LineaError
    
  Dim iNOptions As Integer
  Dim iOption As Integer
  
  Dim iStart As Integer
  
  iNOptions = UBound(aOptions)
  iStart = LBound(aOptions)
'MsgBox KeyAscii
    If KeyAscii = 32 Then
        esp_b = esp_b + 1
        Else
        esp_b = 0
    End If

    If esp_b = 2 Then
        MsgBox "No esta permitido dos espacios en blanco"
        KeyAscii = 8
        esp_b = 0
    End If
  For iOption = iStart To iNOptions

    Select Case aOptions(iOption)
    Case kVKP_ALPHA_ONLY
      
      KeyAscii = IIf( _
          (KeyAscii >= 65 And KeyAscii <= 90) Or _
          (KeyAscii >= 97 And KeyAscii <= 122) Or _
          (KeyAscii = 46) Or _
          (InStr("ÑñáéíóúÁÉÍÓÚ " + Chr(8), Chr(KeyAscii)) <> 0), _
          KeyAscii, 0)
        
    Case kVKP_NUMERIC_ONLY
    
      KeyAscii = IIf( _
          (KeyAscii >= 48 And KeyAscii <= 57) Or _
          (KeyAscii = 46) Or _
          (KeyAscii = 8 Or KeyAscii = 32), _
          KeyAscii, 0)
          
    Case kVKP_NUMERIC_INTEGER_ONLY
    
      KeyAscii = IIf( _
          (KeyAscii >= 48 And KeyAscii <= 57) Or _
          (KeyAscii = 8 Or KeyAscii = 32), _
          KeyAscii, 0)
    
    Case kVKP_UPPER_CASE
    
      KeyAscii = Asc(UCase(Chr(KeyAscii)))
    
    Case kVKP_LOWER_CASE
    
      KeyAscii = Asc(LCase(Chr(KeyAscii)))
        
    End Select
    
  Next
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub


Public Sub DeshabilitarControl(oControl As Control, bColor As Boolean)

  On Error GoTo LineaError

  oControl.Enabled = False
  
  If bColor Then oControl.BackColor = &H80000013
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub

Public Sub HabilitarControl(oControl As Control, bColor As Boolean)

  On Error GoTo LineaError

  oControl.Enabled = True
  
  If bColor Then oControl.BackColor = &H80000005
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub

Public Function RPad(ByVal InString As String, _
                     ByVal iNumChar As Integer, _
                     Optional Char As Variant) As String
                     
  'Completar cadena a la derecha con el caracter indicado cuando sea < que la longitud enviada como parámetro
  
  On Error GoTo LineaError
                        
  Dim WithThisChar As String
  Dim StringChar As String
  Dim iIndex As Integer
    
  StringChar = ""
  WithThisChar = IIf(IsMissing(Char), Space(1), Char)
    
  For iIndex = 1 To iNumChar - Len(InString)
    StringChar = StringChar + WithThisChar
  Next
    
  RPad = InString + StringChar
  
  Exit Function
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Function

Public Function LPad(InString As String, _
                     NumChar As Integer, _
                     Optional Char As Variant) As String
                        
  'Completar cadena a la izquierda con el caracter indicado cuando sea < que la longitud enviada como parámetro
  
  On Error GoTo LineaError
                        
  Dim WithThisChar As String
  Dim StringChar As String
  Dim iIndex As Integer
    
  StringChar = ""
  WithThisChar = IIf(IsMissing(Char), Space(1), Char)
    
  For iIndex = 1 To NumChar - Len(InString)
    StringChar = StringChar + WithThisChar
  Next
    
  LPad = StringChar + InString
  
  Exit Function
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Function

Public Sub CentrarControl(oForm As Object, oControl As Control)

  On Error GoTo LineaError

  oControl.Top = (oForm.ScaleHeight - oControl.Height) / 2
  oControl.Left = (oForm.ScaleWidth - oControl.Width) / 2
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub

Public Sub Internet_Shortcut(URL_Cadena As String, Tipo As Boolean, sArchivo)

  On Error GoTo LineaError
    
  Dim Num_Archivo As Integer
  Dim i As Long
  
  'Crea un archivo Temporal al que se le agrega la ruta URL
  Num_Archivo = FreeFile
  Open sArchivo For Output As #Num_Archivo
  Print #Num_Archivo, "[InternetShortcut]"
  
  If Tipo Then
    Print #Num_Archivo, "URL=" & URL_Cadena
  Else
    Print #Num_Archivo, "URL=" & "MailTo:" & URL_Cadena
  End If
    
  Close #Num_Archivo
    
  'Ejecutar el Explorador por defecto de Internet
  i = Shell("rundll32.exe shdocvw.dll,OpenURL " & sArchivo, vbNormalFocus)
    
  EsperarQueTermine i
    
  'Eliminar el archivo temporal
  Kill sArchivo
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub

Public Function EsperarQueTermine(ByVal PID As Long) As Boolean

  Dim phnd As Long
  
  On Error GoTo Gestion_Error
  
  phnd = OpenProcess(SYNCHRONIZE, 0, PID)
    
  If phnd <> 0 Then
    WaitForSingleObject phnd, INFINITE
    CloseHandle phnd
    EsperarQueTermine = True
  End If
    
  Exit Function
  
Gestion_Error:
    EsperarQueTermine = False
End Function

Public Function ReemplazarComilla(sCampo) As String

  Dim i As Integer
  
  If sCampo <> "" Then
  
    i = 1
  
    Do While i <> 0
  
      i = InStr(i, sCampo, "'")

      If i = 0 Then
        Exit Do
      Else
        sCampo = Mid(sCampo, 1, i - 1) + "' + Chr(39) + '" + Mid(sCampo, i + 1)
        i = i + 15
      End If
    
    Loop
    
  End If
  
  ReemplazarComilla = sCampo
    
End Function

Public Sub CerrarAplicacion(sAplicacion As String)

  Dim winHwnd As Long
  Dim RetVal As Long
  
  winHwnd = FindWindow(vbNullString, sAplicacion)
  Debug.Print winHwnd
  
  If winHwnd <> 0 Then
    RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)
    If RetVal = 0 Then
      MsgBox "No se pudo cerrar la aplicación", vbOKOnly + vbInformation
    End If
  End If
  
End Sub

Public Sub CabeceraImpresion()
  On Error GoTo LineaError
  
  Dim i As Long
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  sSQL = " SELECT * FROM CABECERA_IMPRESION ORDER BY 1"
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  i = 0
  If ADORS.RecordCount > 0 Then
    ReDim sCabecera(ADORS.RecordCount)
    Do While Not ADORS.EOF
      sCabecera(i) = LeerCampo(ADORS("sCabeDescripcion"))
      i = i + 1
      ADORS.MoveNext
    Loop
  End If
   
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
End Sub

Public Sub actualizar()

  Dim cambiacaja As Boolean
  Dim sFechSincro, sProdCode, sProdDesc, sProdDescCrta, sProdPrecUnit, sProdEstd, sRazSocPrv As String
  Dim cClieCode As String, sClieApel, sClieName, sClieAddr, cDistCode, cProvCode, cDepaCode As String
  Dim sFlagCanje, sPtosxItem, sFlagServ, sUndSalida As String
  Dim sClieTelf, sClieMail, dNacmDate, dUltTDate, cTranCode, nPuntCant, TickCant As String
  Dim sClieRout, sDistDesc, sProvDesc, sDepaDesc, sTurnoCodi As String
  Dim nTickCant, nTarjNumb, cTarjActi, dEmisDate, sUserDesc As String
  Dim sOperid, sOperCode, sTarjNumb As String
  Dim cAlmaCode, sProdCant, sOperFech, sOperTipo, sOperFlagAnula, sOperCodeAnula As String
  Dim sOperFlagAbierto, sMontoDolares, sCajacodi, sFlagSincronizacion As String
  Dim sUndmedid, sDscundmd, sDscCrta As String
  Dim smoneda, sMontoSoles, sEfectivoSoles, sVueltoSoles, sGlosa, sEstado, sOperCodeRela, _
    sOperCodeAnul, sDscto, sServicio As String
  Dim sCodCatalog As String
  Dim ADORS As ADODB.Recordset, ADORS1 As ADODB.Recordset
  Dim oRs As ADODB.Recordset
  Dim oRs2 As ADODB.Recordset
  Dim sSQL As String
  Dim bValor As Boolean
  Dim sClieNombres As String
  Dim sDescLinea As String
  sFechSincro = ""
  cambiacaja = False
  
  'Conectar a BD (SQL)
  If Not oDBAdmin.AbrirBD(ADOCnnSQL, psConnectString) Then GoTo Salir


  'ACTUALIZA ARTICULOS
  '-------------------
  
'    sSql = " SELECT A.cCodartic, Replace(A.cCodCatal,'.','') As cCodCatalogo " & _
'           " FROM Articulo A "

    sSQL = " SELECT A.CCODARTIC, L.vDscLinea" & _
           " FROM Linea L, Articulo A " & _
           " WHERE L.CCODLINEA = A.CCODLINEA"

    If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir

    Do While Not oRs.EOF
      sProdCode = LeerCampo(oRs("CCODARTIC"))
      sDescLinea = LeerCampo(oRs("vDscLinea"))
    
      sSQL = " UPDATE PRODUCTO SET " & _
             " sDescLinea = '" & sDescLinea & "'"
      sSQL = sSQL + " WHERE cProdCode = " & sProdCode

      oDBAdmin.EjecutarSentencia ADOCnn, sSQL, False
      
      oRs.MoveNext
    Loop

Salir:

End Sub
Private Function VerificarExisteDocumentoParalelo(ByVal sSerie As String, ByVal sNumero As String, ByVal sCaja As String) As Boolean
  Dim ADORS As ADODB.Recordset
  Dim sSQL As String
      
          
   sSQL = "SELECT * FROM OPERACIONPARALELA WHERE cdocserie='" & sSerie & "' AND CDOCCODIGO=  '" & sNumero & "' and cCajaCodi='" & sCaja & "'"
          
  If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, ADORS) Then GoTo Salir
  
  If Not ADORS.EOF Then
    VerificarExisteDocumentoParalelo = True
    Exit Function
  Else
    VerificarExisteDocumentoParalelo = False
  End If
  
Salir:

End Function


Private Function VerificarExisteDocumento(ByVal sSerie As String, ByVal sNumero As String, ByVal sCaja As String) As Boolean
  Dim ADORS As ADODB.Recordset
  Dim sSQL As String


   sSQL = "SELECT * FROM OPERACION WHERE cdocserie='" & sSerie & "' AND CDOCCODIGO=  '" & sNumero & "' and cCajaCodi='" & sCaja & "'"

  If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, ADORS) Then GoTo Salir

  If Not ADORS.EOF Then
    VerificarExisteDocumento = True
    Exit Function
  Else
    VerificarExisteDocumento = False
  End If

Salir:

End Function

Sub RegistrarZ1(ByVal idEstado As Integer)
  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim cOperId As String
  Dim cOperIdP As String
  Dim sCondicionOpe As String
  Dim sCondicionOpeP As String
  Dim ADORS As ADODB.Recordset
  Dim oRsSP As ADODB.Recordset
  Dim bResult As Boolean

  sSQL = "SELECT cOperId, cOperIdP FROM Configuracion"
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then
    cOperId = ""
    cOperIdP = ""
  Else
    cOperId = LeerCampo(ADORS("cOperId"))
    cOperIdP = LeerCampo(ADORS("cOperIdP"))
  End If
  
  If cOperId = "" Or cOperIdP = "" Then
    sCondicionOpe = "   and o.cOperflagabierto = 1 "
    sCondicionOpeP = "   and o.cOperflagabierto = 1 "
  Else
    sCondicionOpe = "   and o.cOperId > " + cOperId + " "
    sCondicionOpeP = "   and o.cOperCode > " + cOperIdP + " "
  End If

  sSQL = " SELECT o.cCajaCodi, Format(o.dOperFech, 'dd/mm/yyyy') as dOperFech, o.cAlmaCode, o.cDocTipo " & _
       "      , o.cProdCode, sum(o.nProdCant) as cant, sum ((O.nProdCant * O.nProdPrecUnit)+ ((O.nProdCant * O.nProdPrecUnit) * O.nDscto/100)) as precio " & _
       " FROM Operacion o, Producto p " & _
       " Where o.cProdcode = p.cProdcode " & _
       "   and o.cProdcode <> 0 " & _
       sCondicionOpe & _
       "   and o.cOperFlaganula = 0 " & _
       " GROUP BY o.cCajaCodi, Format(o.dOperFech, 'dd/mm/yyyy'), o.cAlmaCode, o.cDocTipo, o.cProdCode " & _
       " Union " & _
       " SELECT o.cCajaCodi, Format(o.dOperFech, 'dd/mm/yyyy') as dOperFech, d.cAlmaCode, o.cDocTipo " & _
       "      , d.cProdCode, sum(d.nProdCant) as cant, sum((d.nProdPrecUnit * d.nProdCant) + ((d.nProdPrecUnit * d.nProdCant) * d.nDscto/100)) as precio " & _
       " FROM OperacionParalelaProducto as d, OperacionParalela as o, Producto as p " & _
       " Where d.cOperCode = o.cOperCode " & _
       "   and d.cProdCode = p.cProdCode " & _
       "   and d.cProdcode <> 0 " & _
       sCondicionOpeP & _
       "   and o.cOperCodeanul= 0 " & _
       "   and ( (o.cEstado = '1' and o.cOpertipo in (20, 21)) or (o.cdocTipo = '11') ) " & _
       " GROUP BY o.cCajaCodi, Format(o.dOperFech, 'dd/mm/yyyy'), d.cAlmaCode, o.cDocTipo, d.cProdCode "
  
  If Not oDBAdmin.AbrirBD(ADOCnnSQL, psConnectString) Then GoTo LineaError
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo LineaError
     
  sSQL = "exec dbo.spr_insertar_cabecera_z1 '" & kPAR_CAJA & "', " & CStr(idEstado)
  Call oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRsSP)
  If Not oRsSP.EOF Then
    idZ1 = LeerCampo(oRsSP("idZ1"))
  End If
  
  Do While Not ADORS.EOF
    sSQL = "INSERT INTO TDETALLEZ1(nidZ1,cCajaCodi,dOperFech,cAlmaCode,cdocTipo,cProdCode,nProdCant,nMonto) " & _
           "VALUES(" & idZ1 & ",'" & LeerCampo(ADORS("cCajaCodi")) & "',CONVERT(DATETIME,'" & _
           LeerCampo(ADORS("dOperFech")) & "',103),'" & LeerCampo(ADORS("cAlmaCode")) & "','" & _
           LeerCampo(ADORS("cDocTipo")) & "','" & LeerCampo(ADORS("cProdCode")) & "'," & _
           LeerCampo(ADORS("cant")) & "," & LeerCampo(ADORS("precio")) & ")"
          
    bResult = oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL, False)
   
    ADORS.MoveNext
  Loop
  
  'Calculando los montos promedios para los productos
  sSQL = "dbo.spr_promediar_montos_z1 " & idZ1
  Call oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL)
  
  GoTo Salir
  
LineaError:
  Screen.MousePointer = vbDefault
Salir:
  Screen.MousePointer = vbDefault
End Sub

Public Sub CorregirSerieOperacion()
  
  If Not oDBAdmin.AbrirBD(ADOCnnSQL, psConnectString) Then MsgBox ""
    
    Dim sql As String
    Dim rsDocCodigoSQL As ADODB.Recordset
    Dim rsDocCodigoAccess As ADODB.Recordset
    Dim rsNewcOperid As ADODB.Recordset
    Dim DocCodigoSql As String
    Dim DocSerieSql As String
    Dim DocCodigoAccess As String
    Dim NewcOperCode As String
    Dim NewcDocTipo As String
          
    sql = "select CDocSerie, MAX(cDoccodigo) as nDoccodigo " & _
          "From operacion where cCajaCodi='" & kPAR_CAJA & "' " & _
          "and ltrim(rtrim(isnull(CDocSerie,''))) <> '' " & _
          "group by CDocSerie"
     
    If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sql, rsDocCodigoSQL) Then MsgBox "Error"
     
    Do While Not rsDocCodigoSQL.EOF
      
      DocCodigoSql = rsDocCodigoSQL!nDocCodigo
      DocSerieSql = rsDocCodigoSQL!cDocSerie
     
      sql = "select nDocCodigo, cTipoDoc from config_documento where cSerieDoc='" & DocSerieSql & "'"
      If oDBAdmin.EjecutarConsulta(ADOCnn, sql, rsDocCodigoAccess) Then
        If Not rsDocCodigoAccess.EOF Then
          DocCodigoAccess = IIf(IsNull(rsDocCodigoAccess!nDocCodigo), "0", rsDocCodigoAccess!nDocCodigo)
        Else
          DocCodigoAccess = "0"
        End If
      Else
        DocCodigoAccess = "0"
      End If
      
      If val(DocCodigoAccess) < val(DocCodigoSql) And val(DocCodigoAccess) > 0 Then
        NewcDocTipo = rsDocCodigoAccess!cTipoDoc
        
        sql = "SELECT MAX(cOperCode) as ncOperCode From operacion " & _
        "where cCajaCodi='" & kPAR_CAJA & "' and " & _
        "CDocSerie = '" & DocSerieSql & "'"
                
        If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sql, rsNewcOperid) Then MsgBox "Error"
        
        NewcOperCode = rsNewcOperid!ncOperCode
        
        ADOCnn.Execute "INSERT INTO OPERACION " & _
        "(cOperCode,cUserDesc,dOperFech," & _
        "cOperFlagAnula,cOperCodeAnula, cOperFlagAbierto," & _
        "cCajaCodi,cFlagSincronizacion,cAlmaCode," & _
        "cDocCodigo,cDocSerie,cDocTipo)" & _
        "VALUES " & _
        "('" & NewcOperCode & "','admin', NOW()," & _
        "'0','0','0'," & _
        " '" & kPAR_CAJA & "','0', '" & kPAR_ALMACEN & "'," & _
        " '" & DocCodigoSql & "' ,'" & DocSerieSql & "','" & NewcDocTipo & "')"
        
        ADOCnn.Execute "UPDATE CONFIG_DOCUMENTO set copercode='" & NewcOperCode & "', ndoccodigo= '" & DocCodigoSql & "'" & _
        " where cseriedoc='" & DocSerieSql & "'"
      End If
      
      rsDocCodigoSQL.MoveNext
    Loop
End Sub

Public Sub CorregirSerieOperacionParalela()
  If Not oDBAdmin.AbrirBD(ADOCnnSQL, psConnectString) Then MsgBox "Error"
    
    Dim sql As String
    Dim rsDocCodigoSQL As ADODB.Recordset
    Dim rsDocCodigoAccess As ADODB.Recordset
    Dim rsNewcOperid As ADODB.Recordset
    Dim DocCodigoSql As String
    Dim DocSerieSql As String
    Dim DocCodigoAccess As String
    Dim NewcOperCode As String
    Dim NewcDocTipo As String
          
    sql = "select CDocSerie, MAX(cDoccodigo) as nDoccodigo " & _
          "From operacionparalela where cCajaCodi='" & kPAR_CAJA & "' " & _
          "and ltrim(rtrim(isnull(CDocSerie,''))) <> '' " & _
          "group by CDocSerie"
     
    If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sql, rsDocCodigoSQL) Then MsgBox "Error"
     
    Do While Not rsDocCodigoSQL.EOF
      
      DocCodigoSql = rsDocCodigoSQL!nDocCodigo
      DocSerieSql = rsDocCodigoSQL!cDocSerie
     
      sql = "select nDocCodigo, cTipoDoc from config_documento where cSerieDoc='" & DocSerieSql & "'"
      If oDBAdmin.EjecutarConsulta(ADOCnn, sql, rsDocCodigoAccess) Then
        If Not rsDocCodigoAccess.EOF Then
          DocCodigoAccess = IIf(IsNull(rsDocCodigoAccess!nDocCodigo), "0", rsDocCodigoAccess!nDocCodigo)
        Else
          DocCodigoAccess = "0"
        End If
      Else
        DocCodigoAccess = "0"
      End If
     
      If val(DocCodigoAccess) < val(DocCodigoSql) And val(DocCodigoAccess) > 0 Then
        NewcDocTipo = rsDocCodigoAccess!cTipoDoc
        
        sql = "SELECT MAX(cOperCode) + 1 as ncOperCode From operacionparalela "
                
        If Not oDBAdmin.EjecutarConsulta(ADOCnn, sql, rsNewcOperid) Then MsgBox "Error"
        
        NewcOperCode = rsNewcOperid!ncOperCode
                
        ADOCnn.Execute "INSERT INTO OPERACIONPARALELA " & _
        "(cOperCode,cOperTipo,dOperFech," & _
        "cEstado,cCajaCodi,cFlagSincronizacion," & _
        "cTurnoCodi,cUserDesc,cOperFlagAbierto," & _
        "cDoccodigo,cdocSerie, cDocTipo) " & _
        "VALUES " & _
        "('" & NewcOperCode & "','0', NOW()," & _
        "'0','" & kPAR_CAJA & "','0'," & _
        "'01','ADMIN', '0'," & _
        " '" & DocCodigoSql & "' ,'" & DocSerieSql & "','" & NewcDocTipo & "')"
        
        ADOCnn.Execute "UPDATE CONFIG_DOCUMENTO set copercode='" & NewcOperCode & "', ndoccodigo= '" & DocCodigoSql & "'" & _
        " where cseriedoc='" & DocSerieSql & "'"
      
      End If
      
      rsDocCodigoSQL.MoveNext
    Loop
End Sub

Public Sub Sincronizar(Optional ByVal DiaAnterior As Boolean)
  Dim cambiacaja As Boolean
  Dim sFechSincro, sProdCode, sProdDesc, sProdDescCrta, sProdPrecUnit, sProdEstd, sRazSocPrv, sDetracc As String
  Dim cClieCode As String, sClieApel, sClieName, sClieAddr, cDistCode, cProvCode, cDepaCode As String
  Dim sFlagCanje, sPtosxItem, sFlagServ, sUndSalida As String
  Dim sClieTelf, sClieMail, dNacmDate, dUltTDate, cTranCode, nPuntCant, TickCant As String
  Dim sClieRout, sDistDesc, sProvDesc, sDepaDesc, sTurnoCodi As String
  Dim nTickCant, nTarjNumb, cTarjActi, dEmisDate, sUserDesc As String
  Dim sOperid, sOperCode, sTarjNumb As String
  Dim cAlmaCode, sProdCant, sOperFech, sOperTipo, sOperFlagAnula, sOperCodeAnula As String
  Dim sOperFlagAbierto, sMontoDolares, sCajacodi, sFlagSincronizacion As String
  Dim sUndmedid, sDscundmd, sDscCrta As String
  Dim smoneda, sMontoSoles, sEfectivoSoles, sVueltoSoles, sGlosa, sEstado, sOperCodeRela, _
    sOperCodeAnul, sDscto, sServicio As String
  Dim sCodCatalog As String
  Dim ADORS As ADODB.Recordset, ADORS1 As ADODB.Recordset, oRsSP As ADODB.Recordset
  Dim rsCabeceraZ As New ADODB.Recordset
  Dim OperInicio, OperFin, OperPInicio, OperPFin As String
  Dim oRs As ADODB.Recordset
  Dim oRs2 As ADODB.Recordset
  Dim sSQL As String
  Dim bValor As Boolean
  Dim sClieNombres As String
  Dim sDescLinea As String
  Dim iTipo As Integer
  Dim cDocCodigo As String
  Dim cDocSerie As String
  Dim cdocTipo As String
  Dim cRuc As String
  Dim i As Integer
  Dim sIdLocal As String
  Dim sSupervisor As String
  Dim vPrecio  As Double

  sFechSincro = ""
  cambiacaja = False
  frmPassword.Hide
  
  'Conectar a BD (SQL)
  If Not oDBAdmin.AbrirBD(ADOCnnSQL, psConnectString) Then GoTo Salir

'  'Idioma
  sSQL = "SET LANGUAGE Spanish"
  If Not oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL) Then
    MsgBox "No se pudo realizar la operación de cambio de Idioma"
  End If

  'captura la ultima fecha de sincronizacion
  sSQL = "SELECT dFechSincro FROM Sincronizacion"
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir

  If ADORS.RecordCount = 1 Then
    sFechSincro = Format(LeerCampo(ADORS("dFechSincro")), "yyyyMMdd")
  End If

  '--------------
  'SINCRONIZACION
  '--------------

  frmUpdt.Show
  If boolSincronizarTodo Then
      'GoTo Uno
      
      'INSERTA NUEVAS UM
      '-----------------
      frmUpdt.InsertaLinea ("Sincronizando Unidades de Medida")
      
      sSQL = " SELECT cUndmedid, vDscundmd, vDscCrta" & _
             " FROM UnidadMedida"
      If sFechSincro <> "" Then sSQL = sSQL & " WHERE dFechCrea > CONVERT(DATETIME, '" + sFechSincro + "',112)"
      If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir
    
      Do While Not oRs.EOF
        sUndmedid = LeerCampo(oRs("cUndmedid"))
        sDscundmd = LeerCampo(oRs("vDscundmd"))
        sDscCrta = LeerCampo(oRs("vDscCrta"))
        
        sSQL = " INSERT INTO UNIDADMEDIDA (cUndmedid, vDscundmd, vDscCrta)"
        sSQL = sSQL + " VALUES ('" + sUndmedid + "', '" + sDscundmd + "', '" + sDscCrta + "')"
        If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
          frmUpdt.InsertaLinea ("Se inserto UM de código: " & sUndmedid)
        Else
          frmUpdt.InsertaLinea ("No se pudo insertar UM de código: " & sUndmedid)
        End If
        
        oRs.MoveNext
      Loop
    
      frmUpdt.AumentaBarra (5)
    
      'ACTUALIZA UM
      '------------
      If sFechSincro <> "" Then
        sSQL = " SELECT cUndmedid, vDscundmd, vDscCrta" & _
               " FROM UnidadMedida" & _
               " WHERE dFechModi > CONVERT(DATETIME, '" + sFechSincro + "',112)" & _
               " AND dFechCrea <= CONVERT(DATETIME, '" & sFechSincro & "',112)"
    
        If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir
    
        Do While Not oRs.EOF
          sUndmedid = LeerCampo(oRs("cUndmedid"))
          sDscundmd = LeerCampo(oRs("vDscundmd"))
          sDscCrta = LeerCampo(oRs("vDscCrta"))
    
          sSQL = " UPDATE UNIDADMEDIDA SET vDscundmd = '" & sDscundmd & "'," & _
                 " vDscCrta = '" & sDscCrta + "'"
          sSQL = sSQL + " WHERE cUndmedid = '" & sUndmedid & "'"
    
          If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
            frmUpdt.InsertaLinea ("Se actualizó UM de código: " & sUndmedid)
          Else
            frmUpdt.InsertaLinea ("No se pudo actualizar UM de código: " & sUndmedid)
          End If
    
          oRs.MoveNext
        Loop
      End If
    
      frmUpdt.AumentaBarra (5)
      frmUpdt.Refresh
      
      'INSERTA NUEVOS ARTICULOS
      '------------------------
      frmUpdt.InsertaLinea ("Sincronizando Articulos")
      
      sSQL = " SELECT A.cCodartic, A.vDscartic, A.cCodCatal, A.vDscartCt, A.bSwActivo, A.bswensamb, A.bswCtrlStck, P.vRazSocPrv," & _
             " cFlagCanje, nPtosxItem, nFlagServ, cUndSalida," & _
             " Linea = (SELECT L.vDscLinea FROM LINEA L WHERE L.CCODLINEA = A.CCODLINEA)," & _
             " nCostoArt = ISNULL((SELECT nPrecioVtaNew FROM ArticuloPrecioVenta B" & _
             " WHERE B.cCodArtic = A.cCodArtic AND nNumItem = " & _
             " (SELECT MAX(nNumItem) FROM ArticuloPrecioVenta C" & _
             " WHERE C.cCodArtic = B.cCodArtic)),0),bFlagDetracc " & _
             " FROM Articulo A LEFT JOIN Proveedor P ON A.cCodProve = P.cCodProve" & _
             " WHERE 1=1 " & _
             "   AND bFlagVenta = 1" & _
             "   AND NOT bFlagDesc = 1"
      'If sFechSincro <> "" Then sSQL = sSQL & " AND convert(datetime,convert(varchar,A.dFechCrea,103)) >= convert(datetime,CONVERT(varchar, '" + sFechSincro + "',103))"
      If sFechSincro <> "" Then sSQL = sSQL & " AND " & _
        " ((convert(datetime,convert(varchar,A.dFechCrea,103),103) >= convert(datetime,CONVERT(varchar, '" & sFechSincro & "',103),103)) or " & _
        " (convert(datetime,convert(varchar,A.dFechModi,103),103) >= convert(datetime,CONVERT(varchar, '" & sFechSincro & "',103),103))) "
    
      If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir
    
      Do While Not oRs.EOF
        'Verificamos si existe el producto en el access
        sSQL = " SELECT cProdCode" & _
               "   FROM producto " & _
               "  WHERE cProdCode = " & val(LeerCampo(oRs("cCodartic")))
        If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, oRs2) Then GoTo Salir
        If oRs2.EOF Then
          sProdCode = LeerCampo(oRs("cCodartic"))
          sProdDesc = LeerCampo(oRs("vDscartic"))
          sProdDescCrta = LeerCampo(oRs("vDscartCt"))
          sProdPrecUnit = CStr(LeerCampo(oRs("nCostoArt")))
          sRazSocPrv = LeerCampo(oRs("vRazSocPrv"))
          sFlagCanje = LeerCampo(oRs("cFlagCanje"))
          sPtosxItem = LeerCampo(oRs("nPtosxItem"))
          sFlagServ = IIf(oRs("nFlagServ"), "1", "0")
          sUndSalida = LeerCampo(oRs("cUndSalida"))
          If (Not oRs("bSwActivo")) Then
            sProdEstd = "1"
          Else
            sProdEstd = "0"
          End If
          'sCodCatalog = Replace(LeerCampo(oRs("cCodCatal")), ".", "")
          sCodCatalog = LeerCampo(oRs("cCodCatal"))
          sDescLinea = LeerCampo(oRs("Linea"))
          If (Not oRs("bFlagDetracc")) Then
            sDetracc = "1"
          Else
            sDetracc = "0"
          End If
    
    
          sSQL = " INSERT INTO PRODUCTO (cAlmaCode, cProdCode, sProdDesc, sProdDescCrta, nProdPrecUnit, cProdEstd, vDescProv, cFlagCanje, nPuntos, cFlagServicio, cUndSalida, cCodCatalogo, sDescLinea,cFlagDetracc)"
          sSQL = sSQL + " VALUES ('" + kPAR_ALMACEN + "', " + sProdCode + ", '" + sProdDesc + "', '" + sProdDescCrta + "', " + sProdPrecUnit + ", " + sProdEstd + ",'" & sRazSocPrv & "'," & sFlagCanje & ", " & sPtosxItem & ", " & sFlagServ & ",'" & sUndSalida & "','" & sCodCatalog & "','" & sDescLinea & "'," & sDetracc & ")"
    
          If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
            frmUpdt.InsertaLinea ("Se insertó Artículo de código: " & sProdCode)
          Else
            frmUpdt.InsertaLinea ("No se pudo insertar Artículo de código: " & sProdCode)
          End If
        End If
    
        oRs.MoveNext
    
      Loop
    
      frmUpdt.AumentaBarra (10)
      frmUpdt.Refresh
      
      'ACTUALIZA ARTICULOS
      '-------------------
      If sFechSincro <> "" Then
      
        sSQL = " SELECT A.cCodartic, A.cCodCatal, A.vDscartic,  A.vDscartCt, A.bSwActivo, A.bswensamb,A.bswCtrlStck, P.vRazSocPrv," & _
               " cFlagCanje, nPtosxItem, nFlagServ, cUndSalida," & _
               " Linea = (SELECT L.vDscLinea FROM LINEA L WHERE L.CCODLINEA = A.CCODLINEA)," & _
               " nCostoArt = ISNULL((SELECT nPrecioVtaNew FROM ArticuloPrecioVenta B" & _
               " WHERE B.cCodArtic = A.cCodArtic AND nNumItem = " & _
               " (SELECT MAX(nNumItem) FROM ArticuloPrecioVenta C" & _
               " WHERE C.cCodArtic = B.cCodArtic)),0),bFlagDetracc " & _
               " FROM Articulo A LEFT JOIN Proveedor P ON A.cCodProve = P.cCodProve" & _
               " WHERE convert(datetime,convert(varchar,A.dFechModi,103),103) >= convert(datetime,'" + sFechSincro + "',103)" & _
               " AND convert(datetime,convert(varchar,A.dFechCrea,103),103) <= convert(datetime,'" & sFechSincro & "',103)" & _
               " AND bFlagVenta = 1" & _
               " AND NOT bFlagDesc = 1"
        
        If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir
    
        Do While Not oRs.EOF
          sProdCode = LeerCampo(oRs("cCodartic"))
          
          
          sProdDesc = LeerCampo(oRs("vDscartic"))
          sProdDescCrta = LeerCampo(oRs("vDscartCt"))
          sProdPrecUnit = CStr(LeerCampo(oRs("nCostoArt")))
          sFlagCanje = LeerCampo(oRs("cFlagCanje"))
          sPtosxItem = LeerCampo(oRs("nPtosxItem"))
          sFlagServ = IIf(oRs("nFlagServ"), "1", "0")
          sUndSalida = LeerCampo(oRs("cUndSalida"))
          If (Not oRs("bSwActivo")) Then
            sProdEstd = "1"
          Else
            sProdEstd = "0"
          End If
          sRazSocPrv = LeerCampo(oRs("vRazSocPrv"))
          'sCodCatalog = Replace(LeerCampo(oRs("cCodCatal")), ".", "")
          sCodCatalog = LeerCampo(oRs("cCodCatal"))
          sDescLinea = LeerCampo(oRs("Linea"))
          If (Not oRs("bFlagDetracc")) Then
            sDetracc = "0"
          Else
            sDetracc = "1"
          End If
    
          sSQL = " UPDATE PRODUCTO SET sProdDesc = '" & sProdDesc & "'," & _
                 " sProdDescCrta = '" & sProdDescCrta + "'," & _
                 " nProdPrecUnit = " & sProdPrecUnit + "," & _
                 " cProdEstd = " & sProdEstd & "," & _
                 " vDescProv = '" & sRazSocPrv & "'," & _
                 " cFlagCanje = " & sFlagCanje & "," & _
                 " nPuntos = " & sPtosxItem & "," & _
                 " cFlagServicio = " & sFlagServ & "," & _
                 " cUndSalida = '" & sUndSalida & "'," & _
                 " cCodCatalogo = '" & sCodCatalog & "'," & _
                 " sDescLinea = '" & sDescLinea & "'," & _
                 " cFlagDetracc=" & sDetracc & ""
    
          sSQL = sSQL & " WHERE cProdCode = " & val(sProdCode)
    
          If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, True) = True Then
            frmUpdt.InsertaLinea ("Se actualizó Artículo de código: " & sProdCode)
          Else
            frmUpdt.InsertaLinea ("No se pudo actualizar Artículo de código: " & sProdCode)
          End If
    
          oRs.MoveNext
        Loop
      End If
    
      frmUpdt.AumentaBarra (10)
    
      'DESACTIVAMOS ARTICULOS QUE YA NO EXISTAN EN EL SQL
      '---------------------------------------------------
      frmUpdt.InsertaLinea ("Desactivando / Activando Articulos")
      
      sSQL = " SELECT cProdCode" & _
             "   FROM producto " & _
             "  WHERE nActivo = 1"
    
      If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, oRs) Then GoTo Salir
    
      Do While Not oRs.EOF
        'Verificamos si existe en el SQL
        sSQL = " SELECT cCodArtic" & _
               "   FROM Articulo " & _
               "  WHERE cCodArtic = '" & Right("000000" & LeerCampo(oRs("cProdCode")), 6) & "'"
        If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs2) Then GoTo Salir
        If oRs2.EOF Then
          'Desactivamos el producto en el access
          sSQL = " UPDATE producto" & _
                 "    SET nActivo = 0" & _
                 "  WHERE cProdCode = " & val(LeerCampo(oRs("cProdCode")))
          
          If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
            frmUpdt.InsertaLinea ("Se inhabilitó Artículo de código: " & LeerCampo(oRs("cProdCode")))
          Else
            frmUpdt.InsertaLinea ("No se pudo inhabilitar Artículo de código: " & LeerCampo(oRs("cProdCode")))
          End If
          sSQL = " UPDATE configuracionTeclado " & _
          "    SET cProdCode = 0  , cTeclFlagAsig='0' where cProdCode=" & val(LeerCampo(oRs("cProdCode")))
          If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
    
        End If
    
        oRs.MoveNext
      Loop
      
      sSQL = " UPDATE configuracionTeclado " & _
             "    SET cProdCode = 0, cTeclFlagAsig='0'  where cProdCode IN (SELECT cProdCode FROM Producto WHERE nActivo =0) "
      If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
    
      'Desactivamos articulos que existen en el access pero que en el sql server han pasado a ser
      'descontinuados o no son para venta
      sSQL = " SELECT cCodArtic" & _
             "   FROM Articulo " & _
             "  WHERE bFlagVenta = 0" & _
             "    OR bFlagDesc = 1"
      If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir
    
      Do While Not oRs.EOF
    
        'Verificamos si el producto en el access esta activo
        sSQL = " Select nActivo from producto where cProdCode=" & val(LeerCampo(oRs("cCodArtic")))
        If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, oRs2) Then GoTo Salir
        If Not oRs2.EOF Then
            
          If val(LeerCampo(oRs2.Fields("nActivo"))) = 1 Then
    
            'Desactivamos el producto en el access si existiese
            sSQL = " UPDATE producto" & _
                   "    SET nActivo = 0" & _
                   "  WHERE cProdCode = " & val(LeerCampo(oRs("cCodArtic")))
    
            If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
              frmUpdt.InsertaLinea ("Se inhabilitó Artículo de código: " & LeerCampo(oRs("cCodArtic")))
            Else
              frmUpdt.InsertaLinea ("No se pudo inhabilitar Artículo de código: " & LeerCampo(oRs("cCodArtic")))
            End If
    
          End If
        End If
        oRs2.Close
        oRs.MoveNext
      Loop
    
      'Activamos articulos qe existen en el sqlserver pero estan desactivados en el access
      sSQL = " SELECT cProdCode" & _
             "   FROM producto " & _
             "  WHERE nActivo = 0"
    
      If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, oRs) Then GoTo Salir
      Do While Not oRs.EOF
        'Verificamos si existe en el SQL
        sSQL = " SELECT cCodArtic, cCodCatal, vDscartic,  vDscartCt" & _
               "   FROM Articulo " & _
               "  WHERE cCodArtic = '" & Right("000000" & LeerCampo(oRs("cProdCode")), 6) & "'" & _
               "    AND bFlagVenta = 1" & _
               "    AND NOT bFlagDesc = 1"
    
        If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs2) Then GoTo Salir
        If Not oRs2.EOF Then
          'Activamos el producto en el access
          sSQL = " UPDATE producto" & _
                 "  SET nActivo = 1," & _
                 "  sProdDesc = '" & LeerCampo(oRs2("vDscartic")) & "'," & _
                 "  sProdDescCrta = '" & LeerCampo(oRs2("vDscartCt")) & "'," & _
                 "  cCodCatalogo = '" & LeerCampo(oRs2("cCodCatal")) & "'" & _
                 "  WHERE cProdCode = " & val(LeerCampo(oRs("cProdCode")))
    
          If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
            frmUpdt.InsertaLinea ("Se habilitó Artículo de código: " & LeerCampo(oRs("cProdCode")))
          Else
            frmUpdt.InsertaLinea ("No se pudo habilitar Artículo de código: " & LeerCampo(oRs("cProdCode")))
          End If
        End If
        oRs.MoveNext
      Loop
      
      frmUpdt.AumentaBarra (10)
      frmUpdt.Refresh
      
      'INSERTA NUEVOS CLIENTES
      '-----------------------
      frmUpdt.InsertaLinea ("Sincronizando Clientes")
      
      sSQL = "SELECT * FROM Cliente"
      If sFechSincro <> "" Then sSQL = sSQL & " where dFechCrea > CONVERT(DATETIME, '" + sFechSincro + "',112)"
      If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir
    
      Do While Not oRs.EOF
        cClieCode = LeerCampo(oRs("cClieCode"))
        sClieApel = LeerCampo(oRs("sClieApel"))
        sClieName = LeerCampo(oRs("sClieName"))
        sClieAddr = LeerCampo(oRs("sClieAddr"))
        cDistCode = LeerCampo(oRs("cDistCode"))
        cProvCode = LeerCampo(oRs("cProvCode"))
        cDepaCode = LeerCampo(oRs("cDepaCode"))
        sClieTelf = LeerCampo(oRs("sClieTelf"))
        sClieMail = LeerCampo(oRs("sClieMail"))
        dNacmDate = Format(LeerCampo(oRs("dNacmDate")), "DD/MM/YYYY")
        dUltTDate = Format(LeerCampo(oRs("dUltTDate")), "DD/MM/YYYY")
        cTranCode = LeerCampo(oRs("cTranCode"))
        nPuntCant = LeerCampo(oRs("nPuntCant"))
        nTickCant = LeerCampo(oRs("nTickCant"))
        sClieRout = LeerCampo(oRs("sClieRout"))
        sDistDesc = LeerCampo(oRs("sDistDesc"))
        sProvDesc = LeerCampo(oRs("sProvDesc"))
        sDepaDesc = LeerCampo(oRs("sDepaDesc"))
    
        sSQL = " INSERT INTO Cliente (cClieCode, sClieApel, sClieName, sClieAddr, cDistCode, cProvCode," & _
               " cDepaCode, sClieTelf, sClieMail, dNacmDate, dUltTDate, cTranCode, nPuntCant, nTickCant," & _
               " sClieRout, sDistDesc, sProvDesc, sDepaDesc)"
        sSQL = sSQL + " VALUES (" + cClieCode + ", '" + sClieApel + "', '" + sClieName + "', '" + sClieAddr + "'," & _
               cDistCode + ", " + cProvCode + "," + cDepaCode + ", '" + sClieTelf + "', '" + sClieMail + "', '" & _
               dNacmDate + "', '" + dUltTDate + "', " + cTranCode + ", " + nPuntCant + ", " + nTickCant + ", '" & _
               sClieRout + "', '" + sDistDesc + "', '" + sProvDesc + "', '" + sDepaDesc + "')"
    
        If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
          frmUpdt.InsertaLinea ("Se insertó Cliente de código: " & cClieCode)
        Else
          frmUpdt.InsertaLinea ("No se pudo insertar Cliente de código: " & cClieCode)
        End If
    
        oRs.MoveNext
      Loop
    
      frmUpdt.AumentaBarra (10)
      frmUpdt.Refresh
      'ACTUALIZA CLIENTES
      '-------------------
      If sFechSincro <> "" Then
        sSQL = " SELECT * FROM Cliente WHERE dFechModi > CONVERT(DATETIME, '" + sFechSincro + "',112)" & _
               " and dFechCrea <= CONVERT(DATETIME, '" + sFechSincro + "',112)"
        If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir
    
        Do While Not oRs.EOF
          cClieCode = LeerCampo(oRs("cClieCode"))
          sClieApel = LeerCampo(oRs("sClieApel"))
          sClieName = LeerCampo(oRs("sClieName"))
          sClieAddr = LeerCampo(oRs("sClieAddr"))
          cDistCode = LeerCampo(oRs("cDistCode"))
          cProvCode = LeerCampo(oRs("cProvCode"))
          cDepaCode = LeerCampo(oRs("cDepaCode"))
          sClieTelf = LeerCampo(oRs("sClieTelf"))
          sClieMail = LeerCampo(oRs("sClieMail"))
          dNacmDate = Format(LeerCampo(oRs("dNacmDate")), "DD/MM/YYYY")
          dUltTDate = Format(LeerCampo(oRs("dUltTDate")), "DD/MM/YYYY")
          cTranCode = LeerCampo(oRs("cTranCode"))
          nPuntCant = LeerCampo(oRs("nPuntCant"))
          nTickCant = LeerCampo(oRs("nTickCant"))
          sClieRout = LeerCampo(oRs("sClieRout"))
          sDistDesc = LeerCampo(oRs("sDistDesc"))
          sProvDesc = LeerCampo(oRs("sProvDesc"))
          sDepaDesc = LeerCampo(oRs("sDepaDesc"))
    
          sSQL = " UPDATE Cliente SET" & _
                 " sClieApel = '" & sClieApel & "'," & _
                 " sClieName = '" & sClieName & "'," & _
                 " sClieAddr = '" & sClieAddr & "'," & _
                 " cDistCode = " & cDistCode & "," & _
                 " cProvCode = " & cProvCode & "," & _
                 " cDepaCode = " & cDepaCode & "," & _
                 " sClieTelf = '" & sClieTelf & "'," & _
                 " sClieMail = '" & sClieMail & "'," & _
                 " dNacmDate = '" & dNacmDate & "'," & _
                 " dUltTDate = '" & dUltTDate & "'," & _
                 " cTranCode = " & cTranCode & "," & _
                 " nPuntCant = " & nPuntCant & "," & _
                 " nTickCant = " & nTickCant & "," & _
                 " sClieRout = '" & sClieRout & "'," & _
                 " sDistDesc = '" & sDistDesc & "'," & _
                 " sProvDesc = '" & sProvDesc & "'," & _
                 " sDepaDesc = '" & sDepaDesc & "',"
          sSQL = sSQL & " WHERE cClieCode = " & cClieCode
    
          If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
            frmUpdt.InsertaLinea ("Se actualizó Cliente de código: " & cClieCode)
          Else
            frmUpdt.InsertaLinea ("No se pudo actualizar Cliente de código: " & cClieCode)
          End If
    
          oRs.MoveNext
        Loop
      End If
    
      frmUpdt.AumentaBarra (10)
      frmUpdt.Refresh
      
      'INSERTA NUEVAS TARJETAS
      '-----------------------
      frmUpdt.InsertaLinea ("Sincronizando Tarjetas")
      
      sSQL = "SELECT * FROM Tarjeta"
      If sFechSincro <> "" Then sSQL = sSQL & " where dFechCrea > CONVERT(DATETIME, '" + sFechSincro + "',112)"
      If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir
    
      Do While Not oRs.EOF
        cClieCode = LeerCampo(oRs("cClieCode"))
        nTarjNumb = LeerCampo(oRs("nTarjNumb"))
        cTarjActi = LeerCampo(oRs("cTarjActi"))
        dEmisDate = Format(LeerCampo(oRs("dEmisDate")), "DD/MM/YYYY")
        sUserDesc = LeerCampo(oRs("sUserDesc"))
    
        sSQL = " INSERT INTO Tarjeta (cClieCode, nTarjNumb, cTarjActi, dEmisDate, sUserDesc,dUltOper)"
        sSQL = sSQL + " VALUES (" + cClieCode + ", " + nTarjNumb + ", " + cTarjActi + ", '" + dEmisDate + "'," & _
               sUserDesc + "',Format(Now, psFORMATO_FECHA_SQL_SERVER_INS))"
    
        If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
          frmUpdt.InsertaLinea ("Se insertó Tarjeta de número: " & nTarjNumb)
        Else
          frmUpdt.InsertaLinea ("No se pudo insertar Tarjeta de número: " & nTarjNumb)
        End If
    
        oRs.MoveNext
      Loop
    
      frmUpdt.AumentaBarra (5)
    
      'ACTUALIZA TARJETAS
      '-------------------
      If sFechSincro <> "" Then
        sSQL = " SELECT * FROM Tarjeta WHERE dFechModi > CONVERT(DATETIME, '" + sFechSincro + "',112)" & _
               " and dFechCrea <= CONVERT(DATETIME, '" + sFechSincro + "',112)"
        If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir
    
        Do While Not oRs.EOF
          cClieCode = LeerCampo(oRs("cClieCode"))
          nTarjNumb = LeerCampo(oRs("nTarjNumb"))
          cTarjActi = LeerCampo(oRs("cTarjActi"))
          dEmisDate = Format(LeerCampo(oRs("dEmisDate")), "DD/MM/YYYY")
          sUserDesc = LeerCampo(oRs("sUserDesc"))
    
          sSQL = " UPDATE Tarjeta SET" & _
                 " cClieCode = " & sClieApel & "," & _
                 " cTarjActi = " & sClieName & "," & _
                 " dEmisDate = '" & sClieAddr & "'," & _
                 " sUserDesc = '" & cDistCode & "'," & _
                 " dUltOper = '" & Format(Now, psFORMATO_FECHA_SQL_SERVER_INS) & "'"
          sSQL = sSQL & " WHERE nTarjNumb = " & nTarjNumb
    
          If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
            frmUpdt.InsertaLinea ("Se actualió Tarjeta de número: " & nTarjNumb)
          Else
            frmUpdt.InsertaLinea ("No se pudo actualizar Tarjeta de número: " & nTarjNumb)
          End If
    
          oRs.MoveNext
        Loop
      End If
    
      frmUpdt.AumentaBarra (5)
      frmUpdt.Refresh
  Else
    frmUpdt.AumentaBarra (70)
    frmUpdt.Refresh
  End If
  
  'SINCRONIZA LAS OPERACIONES REALIZADAS
  '-------------------------------------
  '
  '(OPERACION)
  '-------------------------------------
'Uno:
  frmUpdt.InsertaLinea ("Sincronizando Operaciones")
  
  Dim FechaSincr As String
  Dim bResult As Boolean
  
  If DiaAnterior = False Then
    FechaSincr = Format(Now(), "yyyy.mm.dd")
  ElseIf DiaAnterior = True Then
    FechaSincr = Format(Now() - 1, "yyyy.mm.dd")
  End If

'GoTo Dos
  If Not boolSincronizarCierre Then
    ADOCnnSQL.BeginTrans
    sSQL = "exec dbo.spr_insertar_cabecera_z1 '" & kPAR_CAJA & "', -2"
    Call oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRsSP)
    If Not oRsSP.EOF Then
      idZ1 = LeerCampo(oRsSP("idZ1"))
    End If
    
    ADOCnnSQL.CommitTrans
  End If
  
'Sincronizar operacion y operacion paralela desde CabeceraZ cuando la caja esta abierta o el proceso de cierre este finalizado
Dim iCierreCaja As Integer
Dim rsCierreCaja As ADODB.Recordset

sSQL = "select iCierreCaja from configuracion"
If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, rsCierreCaja) Then MsgBox "Error"
iCierreCaja = rsCierreCaja!iCierreCaja

sSQL = "select * from CabeceraZ where bflagsincro=0"
If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, rsCabeceraZ) Then GoTo Salir

'VERSION 1.0.25
'If rsCabeceraZ.RecordCount > 0 Then

            If iCierreCaja = 0 Or iCierreCaja = 6 Then

             Do While Not rsCabeceraZ.EOF
              OperInicio = LeerCampo(rsCabeceraZ("cOperIdIni"))
              OperFin = LeerCampo(rsCabeceraZ("cOperIdFin"))
              OperPInicio = LeerCampo(rsCabeceraZ("cOperIdPIni"))
              OperPFin = LeerCampo(rsCabeceraZ("cOperIdPFin"))
              
              '------------------------------------
              'Operacion
              '------------------------------------
              sSQL = " SELECT * FROM Operacion" & _
                     " WHERE cOperFlagAbierto = 0 " & _
                     " AND cProdCode <> 0 " & _
                     " and coperid > " & OperInicio & " and coperid <= " & OperFin & " " & _
                     " ORDER BY cOperCode"
            
              If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
              
              cambiacaja = False
              
              Do While Not ADORS.EOF
                ADOCnnSQL.BeginTrans
                sCajacodi = kPAR_CAJA
                sOperid = LeerCampo(ADORS("cOperID"))
                sOperCode = LeerCampo(ADORS("cOperCode"))
                sUserDesc = LeerCampo(ADORS("cUserDesc"))
                sTarjNumb = LeerCampo(ADORS("nTarjNumb"))
                sIdLocal = LeerCampo(ADORS("idLocal"))
                Call RecuperaCliente(sTarjNumb, sIdLocal, cClieCode, sClieNombres, iTipo)
                cAlmaCode = LeerCampo(ADORS("cAlmaCode"))
                sProdCode = Right("000000" + LeerCampo(ADORS("cProdCode")), 6)
                sProdCant = LeerCampo(ADORS("nProdCant"))
                sProdPrecUnit = LeerCampo(ADORS("nProdPrecUnit"))
                sOperFech = Format(LeerCampo(ADORS("dOperFech")), "yyyy-mm-dd hh:nn:ss")
                sOperTipo = LeerCampo(ADORS("cOperTipo"))
                sOperFlagAnula = LeerCampo(ADORS("cOperFlagAnula"))
                sOperCodeAnula = LeerCampo(ADORS("cOperCodeAnula"))
                sOperFlagAbierto = LeerCampo(ADORS("cOperFlagAbierto"))
                sMontoDolares = LeerCampo(ADORS("nMontoDolares"))
               
               '''
               'vPrecio
               'sum((O.nProdCant * O.nProdPrecUnit) + ((O.nProdCant * O.nProdPrecUnit) * O.nDscto / 100)) As precio
               '''''
               
                cDocCodigo = Right("000000" & CStr(val(ADORS("cDocCodigo"))), 6)
                cDocSerie = LeerCampo(ADORS("cDocSerie"))
                cdocTipo = LeerCampo(ADORS("cDocTipo"))
                cRuc = LeerCampo(ADORS("cRuc"))
            
                sFlagSincronizacion = LeerCampo(ADORS("cFlagSincronizacion"))
                sTurnoCodi = LeerCampo(ADORS("cTurnoCodi"))
               'marca
                sDscto = LeerCampo(ADORS("nDscto"))
                sServicio = LeerCampo(ADORS("nServicio"))
                sSupervisor = LeerCampo(ADORS("cSupervisor"))

               'Descuento historico, aqui desconto

                If CDbl(sDscto) < 0 Then
                  Dim SQLINSDESCUENTO As String
                  SQLINSDESCUENTO = "insert into Histdescuentos (fechahora,serie,nrodoc,codiprod,descuento,anulado)" & _
                  " values('" & LeerCampo(ADORS("dOperFech")) & "','" & cDocSerie & "', '" & cDocCodigo & "','" & sProdCode & "'," & sDscto & ", '" & sOperFlagAnula & "')"
            
                  If Not oDBAdmin.EjecutarSentencia(ADOCnn, SQLINSDESCUENTO) Then MsgBox "Error al insertar historico de descuentos"
            
                End If

                
                If sServicio = "" Then sServicio = "0"
               
                '----------------------Consistencia en BD SQL------------------------------------
                'If VerificarExisteDocumento(cDocSerie, cDocCodigo, sCajacodi) = False Then
                        Dim ADORS2 As ADODB.Recordset
                        Dim nroReg As Integer
                        Dim sOperidNew As String
                          
                        sSQL = "SELECT  Count(*) as nroreg " & _
                               "  FROM  Cuentacte " & _
                               " WHERE  cSerieDoc = '" + cDocSerie + "' " & _
                               "   AND  cNroDoc  = '" + cDocCodigo + "' " & _
                               "   AND  cCodCaja = '" + sCajacodi + "' "
                               
                               
                        If oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, ADORS2) Then
                    
                          If (ADORS2!nroReg) > 0 Then
                            EscribirLog "El documento " & cDocSerie + "-" & cDocCodigo + " ya existe en la base de datos."
                            
                            sSQL = "UPDATE operacion SET cFlagSincronizacion = '1' " & _
                                   "WHERE cOperCode = " + sOperCode
                            If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then
                              ADOCnnSQL.RollbackTrans
                              GoTo Salir
                            End If
                            ADOCnnSQL.CommitTrans
                          Else
                            nroReg = 0
                            Set ADORS2 = Nothing
                            '-------------------------------------------------------------------------------------
                            'sSQL = "DELETE from operacion where cOperCOde = " + sOperCode + " AND cOperId=" & sOperid
                            'If oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL) Then
                            
                            sSQL = "SELECT ISNULL(MAX(cOperId),0) + 1 cOperId " & _
                                   "FROM operacion WHERE cCajaCodi='" & kPAR_CAJA & "'"
                            
                            If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, ADORS2) Then GoTo Salir
                            sOperidNew = ADORS2!cOperId
                            Set ADORS2 = Nothing
                      
                            sSQL = " INSERT INTO Operacion (cOperID, cOperCode, cUserDesc, nTarjNumb, cAlmaCode, cProdCode," & _
                                   " nProdCant, nProdPrecUnit, dOperFech, cOperTipo, cOperFlagAnula, cOperCodeAnula," & _
                                   " cOperFlagAbierto, nMontoDolares, cCajacodi, cFlagSincronizacion, cTurnoCodi, " & _
                                   " nDscto, nServicio, cCodiCLie, vDescClie, cDocCodigo, cdocserie, cdoctipo, cruc, iTipoCliente,idlocal) " & _
                                   " VALUES (" & sOperidNew & ", " & sOperCode & ", '" & sUserDesc & "', '" & sTarjNumb & "', '" & _
                                   cAlmaCode & "','" & sProdCode & "', " & sProdCant & ", " & sProdPrecUnit & ", CONVERT(DATETIME,'" & sOperFech & "',120), " & _
                                   sOperTipo & ", " & sOperFlagAnula & ", " & sOperCodeAnula & ", " & sOperFlagAbierto & ", " & _
                                   sMontoDolares & " , '" & sCajacodi & "', '0', '" & sTurnoCodi & "', " & sDscto & ", " & sServicio & ", '" & _
                                   cClieCode & "', '" & sClieNombres & "','" & cDocCodigo & "','" & cDocSerie & "','" & cdocTipo & "','" & cRuc & "'," & Str(iTipo) & ",'" & sIdLocal & "')"
                            

    
                            If oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL, False) Then
                              'Cambia el estado a Sincronizado
                              sSQL = "UPDATE OPERACION SET cFlagSincronizacion = '1' WHERE cOperCOde = " + sOperCode + " AND cOperId=" & sOperid
                                
                              If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL, False) = True Then
                                frmUpdt.InsertaLinea ("Se insertó en el Servidor la Operación de código: " & sOperid)
                                  
                                If Not boolSincronizarCierre Then
                                'comentado version 2.0.5, duplica productos en el cierre y muestra el campo monto NULL cuando se cierra mal la caja
'                                  sSQL = "INSERT INTO TDETALLEZ1(nidZ1,cCajaCodi,dOperFech,cAlmaCode,cdocTipo,cProdCode,nProdCant) " & _
'                                         "VALUES(" & idZ1 & ",'" & sCajacodi & "',CONVERT(DATETIME,'" & sOperFech & "',120),'" & _
'                                         cAlmaCode & "','" & cdocTipo & "','" & LeerCampo(ADORS("cProdCode")) & "'," & _
'                                         sProdCant & ")"
'
'                                  bResult = oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL, False)
                                'fin comentado version 2.0.5
                                End If
                                  
                                ADOCnnSQL.CommitTrans
                              Else
                                frmUpdt.InsertaLinea ("No se pudo insertar en el Servidor la Operación de código: " & sOperid)
                                ADOCnnSQL.RollbackTrans
                              End If
                            Else
                              EscribirLog "No se pudo insertar la operacion de Codigo: " & sOperid
                              ADOCnnSQL.RollbackTrans
                            End If
                          End If
                        Else
                          ADOCnnSQL.RollbackTrans
                          GoTo Salir
                        End If
                'Else
                '        ADOCnnSQL.RollbackTrans
                'End If
                ADORS.MoveNext
              Loop
              
              frmUpdt.AumentaBarra (15)
              frmUpdt.Refresh
              Dim nitem As Long
              
              '(OPERACION PARALELA)
              frmUpdt.InsertaLinea ("Sincronizando Operaciones Paralelas")
              
              sSQL = " SELECT * FROM OperacionParalela" & _
                     " WHERE cOperFlagAbierto= 0 " & _
                     " AND cOperCodeAnul = 0 " & _
                     " AND cOperCode > " & OperPInicio & " AND cOperCode <= " & OperPFin & _
                     " AND NOT cOperCode in  (Select cOperCodeAnul from operacionParalela ) " & _
                     " ORDER BY cOpercode"
              
              If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
              
              Do While Not ADORS.EOF
                ADOCnnSQL.BeginTrans
                sOperCode = LeerCampo(ADORS("cOperCode"))
                sOperTipo = LeerCampo(ADORS("cOperTipo"))
                sOperFech = Format(LeerCampo(ADORS("dOperFech")), "yyyy-mm-dd hh:nn:ss")
                sTarjNumb = LeerCampo(ADORS("nTarjNumb"))
                
                'Call RecuperaCliente(sTarjNumb, "0", cClieCode, sClieNombres, itipo)
                Call RecuperaCliente(sTarjNumb, RetornarIdLocalToOperacionParalelaFromOperacion(CStr(sOperCode), CStr(sOperFech)), _
                cClieCode, sClieNombres, iTipo)
                
                smoneda = LeerCampo(ADORS("nMoneda"))
                sMontoSoles = LeerCampo(ADORS("nMontoSoles"))
                sMontoDolares = LeerCampo(ADORS("nMontoDolares"))
                sEfectivoSoles = LeerCampo(ADORS("nEfectivoSoles"))
                sVueltoSoles = LeerCampo(ADORS("nVueltoSoles"))
                sGlosa = LeerCampo(ADORS("sGlosa"))
                sEstado = LeerCampo(ADORS("cEstado"))
                'sCajacodi = LeerCampo(ADORS("cCajacodi"))
                sCajacodi = kPAR_CAJA
                sFlagSincronizacion = LeerCampo(ADORS("cFlagSincronizacion"))
                sTurnoCodi = LeerCampo(ADORS("cTurnoCodi"))
                sUserDesc = LeerCampo(ADORS("cUserDesc"))
                sOperCodeRela = LeerCampo(ADORS("cOperCodeRela"))
                sOperCodeAnul = LeerCampo(ADORS("cOperCodeAnul"))
                cDocCodigo = Right("000000" & CStr(val(ADORS("cDocCodigo"))), 6)
                cDocSerie = LeerCampo(ADORS("cDocSerie"))
                cdocTipo = LeerCampo(ADORS("cDocTipo"))
                
                If sOperCodeAnul = "" Then sOperCodeAnul = "0"
                  '----------------------Consistencia en BD SQL------------------------------------
                  sSQL = "SELECT  Count(*) as nroreg " & _
                         "  FROM  Cuentacte " & _
                         " WHERE  cSerieDoc = '" + cDocSerie + "' " & _
                         "   AND  cNroDoc  = '" + cDocCodigo + "'" & _
                         "   AND  cCodCaja = '" + sCajacodi + "' "
                           
                  If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, ADORS2) Then
                    ADOCnnSQL.RollbackTrans
                    GoTo Salir
                  End If
                  
                  If (ADORS2!nroReg) > 0 Then
                    EscribirLog "El documento " & cDocSerie + "-" & cDocCodigo + " ya existe en la base de datos."
                          
                          sSQL = "UPDATE  operacionparalela SET cFlagSincronizacion = '1' " & _
                                 "WHERE cOperCode = " + sOperCode
                          If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then
                            ADOCnnSQL.RollbackTrans
                            GoTo Salir
                          End If
                          ADOCnnSQL.CommitTrans
                            
                        Else
                          Set ADORS2 = Nothing
                          '-------------------------------------------------------------------------
                          'sSQL = "DELETE FROM operacionparalela WHERE cOperCOde = " + sOperCode
                          '
                          'If Not oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL) Then
                          '  ADOCnnSQL.RollbackTrans
                          '  GoTo Salir
                          'End If
                    
                          sSQL = " INSERT INTO OperacionParalela (cCajaCodi, cOpercode , cOperTipo, dOperFech, nTarjNumb, nMoneda," & _
                                 " nMontoSoles, nMontoDolares, nEfectivoSoles, nVueltoSoles, sGlosa, cEstado, " & _
                                 " cFlagSincronizacion, cTurnoCodi, cUserDesc, cOperCodeRela, cOperCodeAnul, " & _
                                 " cCodiCLie, vDescClie, iTipocliente, cdoccodigo,cdocserie,cdoctipo)" & _
                                 " VALUES ('" & sCajacodi & "', " & sOperCode & ", " & sOperTipo & ", CONVERT(DATETIME,'" & sOperFech & "',120), '" & sTarjNumb & "', '" & _
                                 smoneda & "'," & sMontoSoles & ", " & sMontoDolares & ", " & sEfectivoSoles & ", " & sVueltoSoles & ", '" & _
                                 sGlosa & "', '" & sEstado & "', '0', '" & _
                                 sTurnoCodi & "' , '" & sUserDesc & "', " & sOperCodeRela & ", " & sOperCodeAnul & ", '" & _
                                 cClieCode & "', '" & sClieNombres & "'," & Str(iTipo) & ",'" & cDocCodigo & "','" & cDocSerie & "','" & cdocTipo & "')"
                    
                          If oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL, False) = True Then
                            'Inserta detalles de la operacion paralela
                            sSQL = " SELECT * FROM OperacionParalelaProducto WHERE cOperCode = " & sOperCode & " and cProdCode <> 0 "
                            Call oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS1)
                            bValor = True
                            i = 0
                            Do While Not ADORS1.EOF
                              i = i + 1
                              cAlmaCode = LeerCampo(ADORS1("cAlmaCode"))
                              sProdCode = Right("000000" + LeerCampo(ADORS1("cProdCode")), 6)
                              sProdCant = LeerCampo(ADORS1("nProdCant"))
                              sProdPrecUnit = LeerCampo(ADORS1("nProdPrecUnit"))
                              sDscto = LeerCampo(ADORS1("nDscto"))
                              nitem = "0" & ADORS1("nItem")
                              sServicio = "0" & ADORS1("nServicio")
                              sSupervisor = LeerCampo(ADORS1("cSupervisor"))
                              
                              'Descuento historico operacion paralela

                               If CDbl(sDscto) < 0 Then
                                 Dim SQLINSDESCUENTOPARALELA As String
                                 SQLINSDESCUENTOPARALELA = "insert into Histdescuentos (fechahora,serie,nrodoc,codiprod,descuento,anulado)" & _
                                 " values('" & LeerCampo(ADORS("dOperFech")) & "','" & cDocSerie & "', '" & cDocCodigo & "','" & sProdCode & "'," & sDscto & ", '" & sEstado & "')"
                           
                                 If Not oDBAdmin.EjecutarSentencia(ADOCnn, SQLINSDESCUENTOPARALELA) Then MsgBox "Error al insertar Historico Descuentos"
                           
                               End If
                                 

                              If i = 1 Then
                                sSQL = "DELETE FROM operacionparalelaproducto WHERE cOperCOde = " + sOperCode
                                If Not oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL) Then
                                  ADOCnnSQL.RollbackTrans
                                  GoTo Salir
                                End If
                              End If
                              
                              sSQL = " INSERT INTO OperacionParalelaProducto (cCajaCodi, cOpercode , cAlmaCode, cProdCode," & _
                                     " nProdCant, nProdPrecUnit, nDscto, nServicio, nitem, cSupervisor)" & _
                                     " VALUES ('" & sCajacodi & "', " & sOperCode & ", '" & cAlmaCode & "', '" & sProdCode & "', " & sProdCant & ", " & _
                                     sProdPrecUnit & "," & sDscto & ", " & sServicio & "," & nitem & ",'" & sSupervisor & "' )"
                                   
                              bValor = bValor And oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL, False)
                              
                              If Not boolSincronizarCierre Then
                              'comentado version 2.0.5, duplica productos en el cierre y muestra el campo monto NULL cuando se cierra mal la caja
'                                sSQL = "INSERT INTO TDETALLEZ1(nidZ1,cCajaCodi,dOperFech,cAlmaCode,cdocTipo,cProdCode,nProdCant) " & _
'                                       "VALUES(" & idZ1 & ",'" & sCajacodi & "',CONVERT(DATETIME,'" & Format(LeerCampo(ADORS("dOperFech")), "yyyy-mm-dd hh:nn:ss") & "',120),'" & _
'                                       cAlmaCode & "','" & cdocTipo & "','" & LeerCampo(ADORS1("cProdCode")) & "'," & sProdCant & ")"
'
'                                bResult = oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL, False)
                              'fin comentado version 2.0.5
                              End If
                                
                              ADORS1.MoveNext
                            Loop
                    
                            If bValor Then
                              sSQL = "UPDATE OPERACIONParalela SET cFlagSincronizacion = '1' WHERE cOpercode = " + sOperCode
                              If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then
                                ADOCnnSQL.CommitTrans
                                frmUpdt.InsertaLinea ("Se insertó en el Servidor la Operación Paralela de código: " & sOperCode)
                              Else
                                ADOCnnSQL.RollbackTrans
                                frmUpdt.InsertaLinea ("No se pudo insertar en el Servidor la Operación Paralela de código: " & sOperCode)
                              End If
                            Else
                              ADOCnnSQL.RollbackTrans
                              frmUpdt.InsertaLinea ("No se pudo insertar en el Servidor la Operación Paralela de código: " & sOperCode)
                            End If
                          Else
                            ADOCnnSQL.RollbackTrans
                            frmUpdt.InsertaLinea ("No se pudo insertar en el Servidor la Operación Paralela de código: " & sOperCode)
                            EscribirLog "No se pudo insertar la operacion Paralela de Codigo: " & sOperCode
                          End If
                        
                        End If
                
                ADORS.MoveNext
              Loop
              
              'Continua Bucle CabeceraZ
              rsCabeceraZ.MoveNext
             Loop



'version 1.0.25

'NUEVA VERSION 1.0.25



If iCierreCaja = 0 Then

   If rsCabeceraZ.EOF Then
   
'     sSQL = " SELECT * FROM Operacion" & _
'               " WHERE FORMAT( DOPERFECH  , 'DD/MM/YYYY')='22/03/2013' " & _
'               " and cprodcode<>0 and copertipo not in(10,11) " & _
'               " ORDER BY cOperCode"

 
'SE OBTIENE FECHA DEL SISTEMA DE LA BASE DE DATOS DE SQL - version 2.0.5
   
   Dim cnFECHASQL As ADODB.Connection
   Dim sqlFECHASIS As String
   Dim rsFEchaSis As ADODB.Recordset
      
   If oDBAdmin.AbrirBD(cnFECHASQL, psConnectString, False) = True Then
     
     sqlFECHASIS = "select convert(varchar,getdate(),120) as fechasis"
    
      If oDBAdmin.EjecutarConsulta(cnFECHASQL, sqlFECHASIS, rsFEchaSis) = True Then
         
         If rsFEchaSis!fechasis <> "" Then
             sFecha = rsFEchaSis!fechasis
         End If

      Else
         'no pudo abrir el rs: que consulte al access
         'MsgBox "No se pudo obtener la fecha, hay problemas de conexión de la red con la Base de Datos Principal", vbOKOnly + vbExclamation, "Aviso"
         sFecha = Format(Now(), "DD/MM/YYYY hh:mm")
         'Unload Me
      End If

     Set cnFECHASQL = Nothing

   Else
     'no pudo conectarse al sql: que consulte al access
      'MsgBox "No se pudo obtener la fecha, hay problemas de conexión de la red con la Base de Datos Principal", vbOKOnly + vbExclamation, "Aviso"
      sFecha = Format(Now(), "DD/MM/YYYY hh:mm")
      'Unload Me
   End If


'     sSQL = "SELECT * FROM Operacion WHERE " & _
'            "FORMAT(DOPERFECH, 'DD/MM/YYYY')=FORMAT((SELECT max(DOPERFECH) FROM Operacion WHERE copertipo not in(10, 11)), 'DD/MM/YYYY')  and cprodcode<>0 and " & _
'            "copertipo not in(10, 11) and FORMAT(doperfech,'DD/MM/YYYY')  <> FORMAT(now(),'DD/MM/YYYY') ORDER BY cOperCode"


      sSQL = "SELECT * FROM Operacion WHERE " & _
            "FORMAT(DOPERFECH, 'DD/MM/YYYY')=FORMAT((SELECT max(DOPERFECH) FROM Operacion WHERE copertipo not in(10, 11)and cprodcode<>0), 'DD/MM/YYYY')  and cprodcode<>0 and " & _
            "copertipo not in(10, 11) and FORMAT(doperfech,'DD/MM/YYYY')  <> FORMAT('" & sFecha & "','DD/MM/YYYY') ORDER BY cOperCode"
 


    
   If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
      
    Do While Not ADORS.EOF
    'ADOCnnSQL.BeginTrans
    sCajacodi = kPAR_CAJA
    sOperid = LeerCampo(ADORS("cOperID"))
    sOperCode = LeerCampo(ADORS("cOperCode"))
    sUserDesc = LeerCampo(ADORS("cUserDesc"))
    sTarjNumb = LeerCampo(ADORS("nTarjNumb"))
    sIdLocal = LeerCampo(ADORS("idLocal"))
    Call RecuperaCliente(sTarjNumb, sIdLocal, cClieCode, sClieNombres, iTipo)
    cAlmaCode = LeerCampo(ADORS("cAlmaCode"))
    sProdCode = Right("000000" + LeerCampo(ADORS("cProdCode")), 6)
    sProdCant = LeerCampo(ADORS("nProdCant"))
    sProdPrecUnit = LeerCampo(ADORS("nProdPrecUnit"))
    sOperFech = Format(LeerCampo(ADORS("dOperFech")), "yyyy-mm-dd hh:nn:ss")
    sOperTipo = LeerCampo(ADORS("cOperTipo"))
    sOperFlagAnula = LeerCampo(ADORS("cOperFlagAnula"))
    sOperCodeAnula = LeerCampo(ADORS("cOperCodeAnula"))
    sOperFlagAbierto = LeerCampo(ADORS("cOperFlagAbierto"))
    sMontoDolares = LeerCampo(ADORS("nMontoDolares"))

    cDocCodigo = Right("000000" & CStr(val(ADORS("cDocCodigo"))), 6)
    cDocSerie = LeerCampo(ADORS("cDocSerie"))
    cdocTipo = LeerCampo(ADORS("cDocTipo"))
    cRuc = LeerCampo(ADORS("cRuc"))

    sFlagSincronizacion = LeerCampo(ADORS("cFlagSincronizacion"))
    sTurnoCodi = LeerCampo(ADORS("cTurnoCodi"))
    sDscto = LeerCampo(ADORS("nDscto"))
    sServicio = LeerCampo(ADORS("nServicio"))
    sSupervisor = LeerCampo(ADORS("cSupervisor"))

'   'Descuento historico
'
'    If CDbl(sDscto) < 0 Then
'      Dim SQLINSDESCUENTO As String
'      SQLINSDESCUENTO = "insert into Histdescuentos (fechahora,serie,nrodoc,codiprod,descuento,anulado)" & _
'      " values('" & LeerCampo(ADORS("dOperFech")) & "','" & cDocSerie & "', '" & cDocCodigo & "','" & sProdCode & "'," & sDscto & ", '" & sOperFlagAnula & "')"
'
'      If Not oDBAdmin.EjecutarSentencia(ADOCnn, SQLINSDESCUENTO) Then MsgBox "Error al insertar Historico de descuentos"
'
'    End If


'----------------------------------------------------------
'---verificar si la operacion esta en la bd de sql
            
            Dim ADORSRevisar As ADODB.Recordset
            'Dim nroReg As Integer
            Dim sOperidNewRev As String
            Dim ssqlRevisar As String
                               
            ssqlRevisar = "select count(1) as nroReg from Operacion " & _
                        "Where copercode=" + sOperCode + " " & _
                        " and cProdCode='" + sProdCode + "' " & _
                        " and cDocTipo='" + cdocTipo + "' " & _
                        " and CDocSerie='" + cDocSerie + "' " & _
                        " and cDocCodigo='" + cDocCodigo + "' " & _
                        " and cOperFlagAnula='" + sOperFlagAnula + "' "
            
       
            If oDBAdmin.EjecutarConsulta(ADOCnnSQL, ssqlRevisar, ADORSRevisar) Then
        
              If (ADORSRevisar!nroReg) = 0 Then

                  ssqlRevisar = "SELECT ISNULL(MAX(cOperId),0) + 1 cOperId " & _
                     "FROM operacion WHERE cCajaCodi='" & kPAR_CAJA & "'"
                
                If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, ssqlRevisar, ADORSRevisar) Then GoTo Salir
                sOperidNewRev = ADORSRevisar!cOperId
                Set ADORSRevisar = Nothing
          
                ssqlRevisar = " INSERT INTO Operacion (cOperID, cOperCode, cUserDesc, nTarjNumb, cAlmaCode, cProdCode," & _
                       " nProdCant, nProdPrecUnit, dOperFech, cOperTipo, cOperFlagAnula, cOperCodeAnula," & _
                       " cOperFlagAbierto, nMontoDolares, cCajacodi, cFlagSincronizacion, cTurnoCodi, " & _
                       " nDscto, nServicio, cCodiCLie, vDescClie, cDocCodigo, cdocserie, cdoctipo, cruc, iTipoCliente,idlocal) " & _
                       " VALUES (" & sOperidNewRev & ", " & sOperCode & ", '" & sUserDesc & "', '" & sTarjNumb & "', '" & _
                       cAlmaCode & "','" & sProdCode & "', " & sProdCant & ", " & sProdPrecUnit & ", CONVERT(DATETIME,'" & sOperFech & "',120), " & _
                       sOperTipo & ", " & sOperFlagAnula & ", " & sOperCodeAnula & ", " & sOperFlagAbierto & ", " & _
                       sMontoDolares & " , '" & sCajacodi & "', '0', '" & sTurnoCodi & "', " & sDscto & ", " & sServicio & ", '" & _
                       cClieCode & "', '" & sClieNombres & "','" & cDocCodigo & "','" & cDocSerie & "','" & cdocTipo & "','" & cRuc & "'," & Str(iTipo) & ",'" & sIdLocal & "')"
                       
      
                If oDBAdmin.EjecutarSentencia(ADOCnnSQL, ssqlRevisar, False) Then
                  
                    ssqlRevisar = "UPDATE OPERACION SET cFlagSincronizacion = '1' WHERE cOperCOde = " + sOperCode + " AND cOperId=" & sOperid
                    
                  If oDBAdmin.EjecutarSentencia(ADOCnn, ssqlRevisar, False) = True Then
                    frmUpdt.InsertaLinea ("Se insertó en el Servidor la Operación de código: " & sOperid)
     '               ADOCnnSQL.CommitTrans
                  Else
                    frmUpdt.InsertaLinea ("No se pudo insertar en el Servidor la Operación de código: " & sOperid)
      '              ADOCnnSQL.RollbackTrans
                  End If
                Else
                  EscribirLog "No se pudo insertar la operacion de Codigo: " & sOperid
       '           ADOCnnSQL.RollbackTrans
                End If

              End If
            Else

               EscribirLog "No se pudo insertar la operacion de Codigo: " & sOperid
        '       ADOCnnSQL.RollbackTrans
            
            End If

    ADORS.MoveNext
  Loop








End If


End If
'FIN ELSE NUEVA VERSION 1.25



            ' fin version 1.0.25

            


            
              
              frmUpdt.InsertaLinea ("Sincronizando los Z")
            
              Dim ADORSZ As ADODB.Recordset
              Dim ADORSZDetalle As ADODB.Recordset
              Dim rsVal As New ADODB.Recordset
              Dim bVal As Boolean
            
              sSQL = "SELECT IdZ,Caja,CantidadTotal,MontoTotal,Fecha,RangoTKBOL,RangoTKFAC,CodigoRep,cOperIdIni,cOperIdFin,cOperIdPIni,cOperIdPFin FROM CabeceraZ WHERE bFlagSincro=0"
            
              Call oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORSZ)
            
              If Not ADORSZ.EOF Then
            
                ADOCnnSQL.BeginTrans
            
                Do While Not ADORSZ.EOF
            
                  rsVal.Open "Select * from CabeceraZ where IdZ=" & ADORSZ!IdZ & " and caja='" & ADORSZ!Caja & "'", ADOCnnSQL, adOpenStatic, adLockReadOnly
                  If rsVal.EOF Then
                    bVal = True
                    sSQL = "INSERT INTO CabeceraZ(IdZ,Caja,CantidadTotal,MontoTotal,Fecha,RangoTKBOL,RangoTKFAC,CodigoRep,cOperIdIni,cOperIdFin,cOperIdPIni,cOperIdPFin) " _
                    & "VALUES (" & ADORSZ!IdZ & ",'" & ADORSZ!Caja & "'," & ADORSZ!CantidadTotal & "," & ADORSZ!MontoTotal & ",'" & ADORSZ!fecha & "','" & ADORSZ!RangoTKBOL & "','" & ADORSZ!RangoTKFAC & "','" & ADORSZ!CodigoRep & "', " & ADORSZ!cOperIdIni & ", " & ADORSZ!cOperIdFin & ", " & ADORSZ!cOperIdPIni & ", " & ADORSZ!cOperIdPFin & " )"
                  Else
                    bVal = False
                    sSQL = "UPDATE CabeceraZ SET obs='Ya existe registro' WHERE IdZ=" & ADORSZ!IdZ
                  End If
                  
                  If Not oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL) Then
                    ADOCnnSQL.RollbackTrans
                    GoTo sigue
                  End If
                  
                  If bVal = True Then
                    sSQL = "SELECT IdZ,Caja,nItem,CodProd,DscProd,Cantidad FROM DetalleZ WHERE bFlagSincro=0 AND IdZ=" & ADORSZ!IdZ & " AND Caja='" & ADORSZ!Caja & "' ORDER BY IdZ,nItem"
                    Call oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORSZDetalle)
            
                    Do While Not ADORSZDetalle.EOF
                    
                      sSQL = "INSERT INTO DetalleZ(IdZ,Caja,nItem,CodProd,DscProd,Cantidad) VALUES (" & ADORSZDetalle!IdZ & ",'" & ADORSZDetalle!Caja & "'," & ADORSZDetalle!nitem & "," & ADORSZDetalle!CodProd & ",'" & ADORSZDetalle!DscProd & "'," & ADORSZDetalle!Cantidad & ")"
                      
                      If Not oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL) Then
                        ADOCnnSQL.RollbackTrans
                        GoTo sigue
                      End If
                      
                      ADORSZDetalle.MoveNext
            
                    Loop
                    ADORSZDetalle.Close
                  End If
            
                  rsVal.Close
                  ADORSZ.MoveNext
                Loop
            
                ADORSZ.Close
                ADOCnnSQL.CommitTrans
            
                ADOCnn.Execute "UPDATE CabeceraZ SET bFlagSincro=1 WHERE bFlagSincro=0"
                ADOCnn.Execute "UPDATE DetalleZ SET bFlagSincro=1 WHERE bFlagSincro=0"
              End If
            
sigue:
              
              frmUpdt.AumentaBarra (15)
              frmUpdt.Refresh
              
              frmUpdt.InsertaLinea ("Registrando procesamiento de movimientos de ventas")
              
              If Not boolSincronizarCierre Then
                sSQL = "dbo.spr_agrupar_z1 " & idZ1
                Call oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL)
              End If
              
              'sSQL = "dbo.OSCMOYMOVIVNTA"
              'Call oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL)
              
              sSQL = "dbo.spr_inserta_sincronizacion '" & kPAR_CAJA & "'"
              Call oDBAdmin.EjecutarSentencia(ADOCnnSQL, sSQL)
              
              frmUpdt.Refresh
              '--------------Depura transacciones Historicas------------------'
              frmUpdt.InsertaLinea ("Depurando transacciones Historicas")
              
              Dim dtFechaLimiteop As Date, dtFechaLimitepar As Date
              Dim n As Integer
              '--------Obteniendo fecha limite ------------------------------'
              dtFechaLimiteop = "1800/01/01"
              dtFechaLimitepar = "1800/01/01"
            
              sSQL = "SELECT distinct cdate(FORMAT( DOPERFECH  , 'DD/MM/YYYY')) as fechalimite " + _
                     "  FROM OPERACION " + _
                     " WHERE DOPERFECH <> #" + Format(DateAdd("d", -1, Date), "DD/MM/YYYY") + "#" + _
                     " ORDER BY 1  desc"
                   
              If oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then
                n = 0
                
                Do While n < 8 And Not ADORS.EOF
                  dtFechaLimiteop = ADORS("fechalimite")
                  n = n + 1
                  ADORS.MoveNext
                Loop
              End If
              Set ADORS = Nothing
            
              sSQL = "SELECT distinct cdate(FORMAT( DOPERFECH  , 'DD/MM/YYYY')) as fechalimite " + _
                     "  FROM OPERACIONPARALELA " + _
                     " WHERE DOPERFECH <> #" + Format(DateAdd("d", -1, Date), "DD/MM/yyyy") + "#" + _
                     " ORDER BY 1  desc"
                   
              If oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then
                n = 0
                Do While n < 8 And Not ADORS.EOF
                  dtFechaLimitepar = ADORS("fechalimite")
                  n = n + 1
                  ADORS.MoveNext
                Loop
              End If
              Set ADORS = Nothing
              '--------------------------------------------------------------'
              frmUpdt.InsertaLinea ("Eliminando operaciones Históricas")
                
              sSQL = "INSERT INTO OPERACIONPARALELAPRODUCTOHIST" & _
                    " SELECT * FROM  OPERACIONPARALELAPRODUCTO WHERE cOperCode IN " & _
                    " (SELECT cOpercode FROM OPERACIONPARALELA WHERE cFlagSincronizacion ='1' AND dOperFech < #" & Format(dtFechaLimitepar, "mm/dd/yyyy") & "# AND  not(cEstado='1') AND not (cDocTipo in('12','13'))) "
              If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
                     
              sSQL = "DELETE from OPERACIONPARALELAPRODUCTO WHERE cOperCode IN " & _
                    " (SELECT cOpercode FROM OPERACIONPARALELA WHERE cFlagSincronizacion ='1' AND dOperFech < #" & Format(dtFechaLimitepar, "mm/dd/yyyy") & "# AND  not(cEstado='1')AND not (cDocTipo in('12','13'))) "
              If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
              
              sSQL = "INSERT INTO OPERACIONPARALELA_HISTORICO  " & _
                     " SELECT * FROM OPERACIONPARALELA " & _
                     "WHERE cFlagSincronizacion ='1' AND dOperFech < #" & Format(dtFechaLimitepar, "mm/dd/yyyy") & "#  AND  NOT(cEstado='1') AND not (cDocTipo in('12','13')) "
              If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
              
              sSQL = "DELETE FROM OPERACIONPARALELA WHERE cFlagSincronizacion ='1' AND dOperFech < #" & Format(dtFechaLimitepar, "mm/dd/yyyy") & "# AND  NOT (cEstado='1') AND not (cDocTipo in('12','13')) "
              If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
                    
              sSQL = "INSERT INTO OPERACION_HISTORICO  " & _
                     " SELECT  * FROM OPERACION WHERE cFlagSincronizacion ='1' AND cDoctipo<>'01' AND dOperFech < #" & Format(dtFechaLimiteop, "mm/dd/yyyy") & "# "
              If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
              
              sSQL = "DELETE FROM OPERACION WHERE cFlagSincronizacion ='1' AND cDoctipo<>'01' AND dOperFech < #" & Format(dtFechaLimiteop, "mm/dd/yyyy") & "# "
              If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
              
               sSQL = "DELETE FROM OPERACIONPARALELAPRODUCTOHIST WHERE cOpercode in (SELECT copercode FROM OPERACIONPARALELA WHERE DOPERFECH <  dateadd( 'm', -3, date()))"
              If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
              
              sSQL = "DELETE FROM OPERACIONPARALELA_HISTORICO WHERE DOPERFECH <  dateadd( 'm', -3, date())"
              If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
              
              sSQL = "DELETE FROM OPERACION_HISTORICO WHERE DOPERFECH <  dateadd( 'm', -3, date())"
              If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
               
              '---------------------------------------------------------------'
              'ACTUALIZA LOS DATOS EN SINCRONIZACION
              '-------------------------------------
              sSQL = "SELECT FECHA = GETDATE()"
              If Not oDBAdmin.EjecutarConsulta(ADOCnnSQL, sSQL, oRs) Then GoTo Salir
              Do While Not oRs.EOF
                sFechSincro = Format(oRs("FECHA"), "yyyy/mm/dd")
                oRs.MoveNext
              Loop
            
              sSQL = "UPDATE Sincronizacion SET dFechSincro = '" + sFechSincro + "'"
              If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
            
              frmUpdt.AumentaBarra (5)
            
              frmUpdt.Refrescar
              frmUpdt.Label1 = "La Sincronización ha finalizado"
            
              GoTo Salir2

End If



Salir:
  frmUpdt.lblEtiqueta.Caption = "Hubieron errores en la sincronización"
Salir2:
  Set ADORS = Nothing
  frmUpdt.prgBar.Value = 0
  Unload frmUpdt
End Sub

Public Sub ConfiguraImpresora(nombre As String)

  Dim i As Integer
  For i = 0 To Printers.Count - 1
    If Printers(i).DeviceName = nombre Then
      Set printer = Printers(i)
      Exit For
    End If
  Next i
  
End Sub

'sw To SQL Server era
'sw Public Function ObtenerPuntosAcumulados(aTarjeta As String) As String
Public Function ObtenerPuntosAcumulados(aTarjeta As String, ByVal idLocal As String) As String
  On Error GoTo LineaError

  Dim sSQL As String
  Dim strCodigoCliente As String
  Dim ADORS As ADODB.Recordset

  ObtenerPuntosAcumulados = "0"
  'sw era solo >>> If bolExisteConexionBDCliente = False Then
  If bolExisteConexionBDCliente = False Then
    ConectarBDCliente
  End If
  
  'sw FALTA idLocal
  'sw To SQL Server add >>> AND IdLocal = $
  sSQL = " SELECT cClieCode AS Codigo " & _
         "   FROM Tarjeta " & _
         "  WHERE nTarjNumb = '$' " & _
         "    AND IdLocal = $ "
  
  'sw To SQL Server add >>> IdLocal
  sSQL = VBsprintf(sSQL, aTarjeta, idLocal)
  If Not oDBAdmin.EjecutarConsulta(ADOCnn2, sSQL, ADORS) Then GoTo LineaError
  
  If Not ADORS.EOF Then
    If LeerCampo(ADORS!Codigo) <> "" Then
      strCodigoCliente = CStr(ADORS!Codigo)
    End If
  Else
    ObtenerPuntosAcumulados = -1
    GoTo Salir
  End If

  'consultamos de BD cliente
 
  If bolExistenProblemasConexionBDCliente = False Then
    ConectarBDCliente     'Abrimos conexion
  End If
  
  If bolExisteConexionBDCliente = True Then
  
    'sw FALTA idLocal
    'sw To SQL Server add >>> AND IdLocal = $
    sSQL = " SELECT nPuntcant " & _
           "   FROM CLIENTE" & _
           "  WHERE iTipo=1 AND cClieCode = $ " & _
           "    AND IdLocal = $"
    
    'sw To SQL Server add >>> IdLocal
    sSQL = VBsprintf(sSQL, strCodigoCliente, idLocal)
    If Not oDBAdmin.EjecutarConsulta(ADOCnn2, sSQL, ADORS) Then GoTo Salir
      
    If Not ADORS.EOF Then
      ObtenerPuntosAcumulados = CStr(val(LeerCampo(ADORS!nPuntCant)))
    Else
      ObtenerPuntosAcumulados = -1
    End If

'      oDBAdmin.CerrarBD ADOCnn2     'Cerramos conexion
'      bolExisteConexionBDCliente = False
  Else
  
    ObtenerPuntosAcumulados = -1
  
  End If
 
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
End Function

Public Sub Guarda_Puntos(aTarjeta As String, aTipo As String, _
     cTipo As String, cSerie As String, cCodigo As Long, _
     aValor As Double, Optional aValPto As Double = 0, Optional ByVal nIdLocal As Integer)
 
  Dim sSQL As String
  Dim sCodigo As String, cCliente As String
  Dim lpunto As Long
  Dim ADORS As ADODB.Recordset
  Dim sFecha As String
  
  'sw To SQL Server era >>> nIdLocal
  sSQL = "SELECT cClieCode AS Codigo FROM Tarjeta " + _
         "WHERE nTarjNumb = '$' AND IdLocal= $ "
  sSQL = VBsprintf(sSQL, aTarjeta, nIdLocal)
  
  If bolExisteConexionBDCliente = False Then
    ConectarBDCliente
  End If
  
  If Not oDBAdmin.EjecutarConsulta(ADOCnn2, sSQL, ADORS) Then GoTo LineaError
  
  If Not ADORS.EOF Then
    If LeerCampo(ADORS!Codigo) <> "" Then
      cCliente = CStr(ADORS!Codigo)
    End If
  End If
  
  'sw To SQL Server era >>> nIdLocal
  sSQL = "SELECT iTipo AS Tipo FROM Cliente " + _
         "WHERE cClieCode = $ AND IdLocal=$ "
  sSQL = VBsprintf(sSQL, cCliente, nIdLocal)
  If Not oDBAdmin.EjecutarConsulta(ADOCnn2, sSQL, ADORS) Then GoTo LineaError
  
  'If "0" & (ADORS!Tipo) <> 1 Then GoTo Salir
  If (ADORS!Tipo) <> 1 Then GoTo Salir

  'sw To SQL Server era >>> nIdLocal
  sSQL = "SELECT MAX(cAcumCode) AS Codigo FROM $ " + _
         "WHERE cClieCode = $ AND IdLocal= $ "
  sSQL = VBsprintf(sSQL, "Acumulacion_Punto", cCliente, nIdLocal)
  
  If Not oDBAdmin.EjecutarConsulta(ADOCnn2, sSQL, ADORS) Then GoTo LineaError

  sCodigo = "1"

  If Not ADORS.EOF Then
    If LeerCampo(ADORS!Codigo) <> "" Then
      sCodigo = CStr(ADORS!Codigo + 1)
    End If
  End If
  Set ADORS = Nothing
  
  'Si los puntos son solo por venta
  'If aTipo = "VNTA" Then
  lpunto = Int(aValor / lReglaPuntoImporte) * lReglaPuntoCantidad
  'ElseIf aTipo = "PTOS" Then
  '  lpunto = aValor
  '  aValor = aValPto
 ' End If
 
 'Actualizamos en BD cliente
 
  If bolExistenProblemasConexionBDCliente = False Then
    ConectarBDCliente     'Abrimos conexion
  End If
  
   
  sFecha = "convert(datetime,'" & Format(Now, "yyyy-mm-dd hh:nn:ss") & "',120)"
  
  If bolExisteConexionBDCliente = True Then
    'sw To SQL Server era >>> nIdLocal
    sSQL = "SELECT MAX(cAcumCode) AS Codigo FROM $ " + _
           "WHERE cClieCode = $ AND IdLocal= $ "
    sSQL = VBsprintf(sSQL, "Acumulacion_Punto", cCliente, nIdLocal)
    If Not oDBAdmin.EjecutarConsulta(ADOCnn2, sSQL, ADORS) Then GoTo LineaError
    
    sCodigo = "1"
    
    If Not ADORS.EOF Then
      If LeerCampo(ADORS!Codigo) <> "" Then
        sCodigo = CStr(ADORS!Codigo + 1)
      End If
    End If
    Set ADORS = Nothing
      
    'sw To SQL Server era >>> nIdLocal >>> "yyyy/mm/dd hh:mm"
    sSQL = "INSERT INTO Acumulacion_Punto (cClieCode, cAcumCode, nTarjNumb, " + _
           "nAcumImpo, nPuntCant, sUserDesc, dAcumDate, cDocTipo, cDocSerie, cDocCodigo, IdLocal) " + _
           "VALUES($, $, '$', $, $, '$', $, '$', '$', $, $)"
    
    sSQL = VBsprintf(sSQL, cCliente, sCodigo, aTarjeta, _
           Format(aValor, "####0"), Format(lpunto, "####0"), _
           ReemplazarComilla(psUsuario_Descripcion), sFecha, _
           cTipo, cSerie, cCodigo, nIdLocal)
           
    'sSQL = VBsprintf(sSQL, cCliente, sCodigo, aTarjeta, _
    '        Format(aValor, "####0"), Format(lpunto, "####0"), _
    '        ReemplazarComilla(psUsuario_Descripcion), Format(Now, psFORMATO_FECHA_SQL_SERVER_INS), _
    '        cTipo, cSerie, cCodigo, nIdLocal)
    If Not oDBAdmin.EjecutarSentencia(ADOCnn2, sSQL) Then GoTo LineaError
    
    'sw To SQL Server era >>> nIdLocal >>> "yyyy/mm/dd"
    sSQL = "UPDATE Cliente SET nPuntCant = ISNULL(nPuntCant,0) + $, " + _
           "dUltTDate = $, cTranCode = $,bFlagSincro= $ " + _
           "WHERE cClieCode = $ AND IdLocal= $ "
    sSQL = VBsprintf(sSQL, Format(lpunto, "####0"), _
           sFecha, _
           kTRAN_ACUMULA_PUNTOS, 0, _
           cCliente, nIdLocal)
    If Not oDBAdmin.EjecutarSentencia(ADOCnn2, sSQL) Then GoTo LineaError
      
    oDBAdmin.CerrarBD ADOCnn2     'Cerramos conexion
    bolExisteConexionBDCliente = False
      
  Else
  
    'sw Insersion sobre OmniPos.Acumulacion_Punto
    'sw To SQL Server add >>> IdLocal
    sSQL = "INSERT INTO Acumulacion_Punto (cClieCode, cAcumCode, nTarjNumb, " + _
           "nAcumImpo, nPuntCant, sUserDesc, dAcumDate, cSincroFlag, cDocTipo, cDocSerie, cDocCodigo, IdLocal) " + _
           "VALUES($, $, '$', $, $, '$', $, $, '$', '$', $, $)"
    sSQL = VBsprintf(sSQL, cCliente, sCodigo, aTarjeta, _
           Format(aValor, "####0"), Format(lpunto, "####0"), _
           ReemplazarComilla(psUsuario_Descripcion), sFecha, _
           0, cTipo, cSerie, cCodigo, nIdLocal)
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError
    
    'sw Insersion sobre OmniPos.Acumulacion_Punto
    'sw To SQL Server add >>> AND IdLocal
    sSQL = "UPDATE Cliente SET nPuntCant = nPuntCant + $, " + _
           "       dUltTDate = $, cTranCode = $, cSincroFlag = 0 " + _
           " WHERE cClieCode = $ " + _
           "   AND IdLocal = $"
    sSQL = VBsprintf(sSQL, Format(lpunto, "####0"), _
           sFecha, _
           kTRAN_ACUMULA_PUNTOS, _
           cCliente, nIdLocal)
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError
    
  End If
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
End Sub

Public Sub RecuperaCliente(ByVal sTarjeta As String, ByVal sIdLocal As String, ByRef cCliente As String, ByRef sCliente As String, ByRef iTipo As Integer)

  Dim oRs As ADODB.Recordset
  Dim sSQL As String
  cCliente = "0"
  sCliente = "Público en General"
  iTipo = 0
  If bolExisteConexionBDCliente = False Then
     ConectarBDCliente
  End If
  
  If bolExisteConexionBDCliente Then
  
    'sw FALTA nIdLocal
    sSQL = " SELECT Cliente.cClieCode, Cliente.sClieApel, Cliente.sClieName, Cliente.iTipo " & _
           " FROM Cliente INNER JOIN Tarjeta ON Cliente.cClieCode = Tarjeta.cClieCode" & _
           " WHERE Tarjeta.nTarjNumb = '" & sTarjeta & "' AND Cliente.IdLocal='" & sIdLocal & "'"
    If Not oDBAdmin.EjecutarConsulta(ADOCnn2, sSQL, oRs) Then Exit Sub
    Do While Not oRs.EOF
      sCliente = Left(LeerCampo(oRs("sClieApel")) + " " + LeerCampo(oRs("sClieName")), 50)
      cCliente = LeerCampo(oRs("cClieCode"))
      iTipo = CInt("0" & oRs("iTipo"))
      oRs.MoveNext
    Loop
  End If
  Set oRs = Nothing
Salir:
  
End Sub

Public Sub SincronizaDatosCliente()
  On Error GoTo LineaError

  Dim sSQL As String
  Dim sCodigo As String, cCliente As String
  Dim lpunto As Long
  Dim ADORS As ADODB.Recordset
  Dim ADORS2 As ADODB.Recordset
  
  Dim cClieCode As String
  Dim cAcumCode As String
  Dim nTarjNumb As String
  Dim nAcumImpo As Double
  Dim nPuntCant As Double
  Dim sUserDesc As String
  Dim dAcumDate As String
  Dim cTranCode As String
  Dim dUltTDate As String
  Dim cTipoDoc As String
  Dim cSerieDoc As String
  Dim cCodigoDoc As Long
  
  'sw To SQL Server
  Dim idLocal As String
  Dim idLocal_2 As String

  Screen.MousePointer = vbHourglass

  'Manejo de la Tabla Cliente
  'sw =======================
  sSQL = "SELECT * " & _
         "FROM Cliente " & _
         "WHERE cSincroFlag = 0 " & _
         "ORDER BY dUltTDate"
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  

  Do While Not ADORS.EOF
    
    cClieCode = LeerCampo(ADORS!cClieCode)
    cTranCode = LeerCampo(ADORS!cTranCode)
    dUltTDate = Format(CDate(LeerCampo(ADORS!dUltTDate)), "MM/dd/yyyy")
    'sw To SQL Server
    idLocal = LeerCampo(ADORS!idLocal)
  
    'Actualizamos el registro de Cliente
    'sw To SQL Server era >>> # CAMPO_FECHA # | add >>> AND IdLocal
    sSQL = "UPDATE Cliente " & _
           "   SET dUltTDate = '" & dUltTDate & "', " & _
           "       cTranCode = " & cTranCode & _
           " WHERE cClieCode = " & cClieCode & _
           "   AND IdLocal = " & idLocal
    If Not oDBAdmin.EjecutarSentencia(ADOCnn2, sSQL) Then GoTo Salir
    

    'Actualizamos el Flag
    'sw To SQL Server add >>> AND IdLocal
    sSQL = "UPDATE Cliente " & _
           "   SET cSincroFlag = 1 " & _
           " WHERE cClieCode = " & cClieCode & _
           "   AND IdLocal = " & idLocal
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir

    ADORS.MoveNext
  Loop
  
  'Sincronizamos registros en la tabla Acumulacion_Punto
  'sw ==================================================
  sSQL = "SELECT * " & _
         "  FROM Acumulacion_Punto " & _
         " WHERE cSincroFlag = 0"
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir


  Do While Not ADORS.EOF
    
    cClieCode = LeerCampo(ADORS!cClieCode)
    nTarjNumb = LeerCampo(ADORS!nTarjNumb)
    nAcumImpo = (LeerCampo(ADORS!nAcumImpo))
    nPuntCant = LeerCampo(ADORS!nPuntCant)
    sUserDesc = LeerCampo(ADORS!sUserDesc)
    dAcumDate = Format(CDate(LeerCampo(ADORS!dAcumDate)), "MM/dd/yyyy")
    cTipoDoc = LeerCampo(ADORS!cdocTipo)
    cSerieDoc = LeerCampo(ADORS!cDocSerie)
    cCodigoDoc = LeerCampo(ADORS!cDocCodigo)
    
    'sw To SQL Server
    idLocal_2 = LeerCampo(ADORS!idLocal)
  

    'sw To SQL Server add >>> AND IdLocal
    sSQL = "SELECT MAX(cAcumCode) AS Codigo FROM $ " + _
           " WHERE cClieCode = $ " & _
           "   AND IdLocal = $"
    sSQL = VBsprintf(sSQL, "Acumulacion_Punto", cClieCode, idLocal_2)
    If Not oDBAdmin.EjecutarConsulta(ADOCnn2, sSQL, ADORS2) Then GoTo Salir
      
    cAcumCode = "1"
      
    If Not ADORS2.EOF Then
      If LeerCampo(ADORS2!Codigo) <> "" Then
        cAcumCode = CStr(ADORS2!Codigo + 1)
      End If
    End If

    'Insertamos el nuevo registro de Acumulacion_Punto
    'sw To SQL Server era >>> # CAMPO_FECHA # | add >>> IdLocal
    sSQL = " INSERT INTO Acumulacion_Punto" & _
           "             (cClieCode, cAcumCode, nTarjNumb, nAcumImpo, " & _
           "              nPuntCant, sUserDesc, dAcumDate, cDocTipo, cDocSerie, cDocCodigo, IdLocal) " & _
           "      VALUES (" & cClieCode & "," & cAcumCode & ",'" & nTarjNumb & "'," & _
           "              " & nAcumImpo & "," & nPuntCant & ",'" & sUserDesc & "'," & _
           "'" & dAcumDate & "','" + cTipoDoc + "','" + cSerieDoc + "'," + CStr(cCodigoDoc) + ", " + idLocal_2 + ")"
    

    If Not oDBAdmin.EjecutarSentencia(ADOCnn2, sSQL) Then GoTo Salir
    
    'Actualizamos el puntaje en la tabla Cliente
    'sw To SQL Server add >>> AND IdLocal
    sSQL = " UPDATE Cliente" & _
           "    SET nPuntCant = nPuntCant + " & nPuntCant & _
           "  WHERE cClieCode = " & cClieCode & _
           "    AND IdLocal = " & idLocal_2
    If Not oDBAdmin.EjecutarSentencia(ADOCnn2, sSQL) Then GoTo Salir

    'Actualizamos Flag
    'sw To SQL Server add >>> AND IdLocal
    sSQL = " UPDATE Acumulacion_Punto" & _
           "    SET cSincroFlag = 1" & _
           "  WHERE cClieCode = " & cClieCode & _
           "    AND cAcumCode = " & LeerCampo(ADORS!cAcumCode) & _
           "    AND IdLocal = " & idLocal_2
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir

    ADORS.MoveNext
  Loop
  
  Screen.MousePointer = vbDefault
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
  Set ADORS2 = Nothing
  Screen.MousePointer = vbDefault
End Sub

'Public Sub CortePapelSerial(MSComm1 As MSComm)
'    On Error Resume Next
'
'    If Not MSComm1.PortOpen = True Then
'        MSComm1.PortOpen = True  ' abre puerto serial
'    End If
'
'    MSComm1.Output = Chr$(27) + Chr$(64)   'inicializa la impresora
'
'    MSComm1.Output = Chr$(29) + Chr$(86) + Chr$(1) 'realiza corte de papel
'
'    MSComm1.PortOpen = False
'
'
'End Sub
'
'
'Public Sub CortePapelParalelo(IO1 As IO)
'    On Error Resume Next
''
''    Result = IO1.Open("LPT1:", "")     ' abre puerto paralelo
''    Result = IO1.WriteString(Chr$(29) + Chr$(86) + Chr$(1))   'realiza corte de papel
''    Result = IO1.Close()
'
'End Sub

Public Sub CortePapel(Texto As String, p As Integer, Optional archivo As String)
  On Error GoTo LineaError
  Dim NameArchivo As String
  Dim fso, MyFile
  Set fso = CreateObject("Scripting.FileSystemObject")

  If Trim(archivo) = "" Then
    archivo = "textfile"
  End If
  NameArchivo = "C:\temp\" + Trim(archivo) + ".prn"

  Set MyFile = fso.CreateTextFile(NameArchivo, True)
  'Set MyFile = fso.CreateTextFile("c:\textfile.prn", True)

  MyFile.WriteLine (Chr$(27) + Chr$(64))
  MyFile.WriteLine (Texto)
  MyFile.WriteLine (vbCrLf)
  MyFile.WriteLine (vbCrLf)
  MyFile.WriteLine (vbCrLf)
  MyFile.WriteLine (vbCrLf)
  MyFile.WriteLine (Chr$(29) + Chr$(86) + Chr$(1))
  'MyFile.WritLine (Chr(27) & Chr(112) & Chr(48) & Chr(55) & Chr(121))
  MyFile.Close

  Set MyFile = fso.GetFile(NameArchivo)
  EscribirLog ("p:" & CStr(p) & ";kPAR_IMPRESORA:" & kPAR_IMPRESORA & ";printer.Port:" & CStr(printer.Port) & ";psPuertoPrint:" & LeerCfg("PARAMETROS", "PuertoPrinter", psArchivoCfg) & ";kPAR_IMPRESORA_ALTERNA:" & kPAR_IMPRESORA_ALTERNA & ";NameArchivo:" & NameArchivo & ";")
  
'MsgBox NameArchivo
  If p = 1 Then 'sw Modificado, se Add condiciones
    'MsgBox "1"
    If Left(kPAR_IMPRESORA, 1) <> "\" Then
        
      If Left(printer.Port, 3) = "COM" Then 'sw Add
        Shell "cmd.exe /c TYPE " & NameArchivo & " > " & printer.Port 'sw Add
      Else 'sw Add
        'sw Modificado para GV NORTE - 06/02/2010
        'MyFile.Copy ("LPT1")
        'sw Ahora envia el Documento al Puerto X, indicado en la configuración Impresora Principal.
        psPuertoPrint = LeerCfg("PARAMETROS", "PuertoPrinter", psArchivoCfg)
        'MsgBox "psPuertoPrint " + psPuertoPrint
        If psPuertoPrint = "" Then
            MyFile.Copy ("LPT1")
        Else
            MyFile.Copy (psPuertoPrint)
        End If
        ' Shell ("TYPE " + NameArchivo + " > LPT1")
      End If 'sw Add
    Else
      MyFile.Copy (kPAR_IMPRESORA)

    End If
  Else
    'MsgBox "<>1"
    If Left(kPAR_IMPRESORA, 1) <> "\" Then
      If Left(printer.Port, 3) = "COM" Then 'sw Add
        Shell "cmd.exe /c TYPE " & NameArchivo & " > " & printer.Port 'sw Add
      Else 'sw Add
        Dim lpt As String
        lpt = Left(printer.Port, 4)
        'MyFile.Copy ("LPT2")
        MyFile.Copy lpt
      End If 'sw Add
    Else
      MyFile.Copy (kPAR_IMPRESORA_ALTERNA)
    End If
  End If

  'MyFile.Delete
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub

Public Sub CortePapelGrande(ByRef sImprimir() As String, p As Integer, bloques As Integer, Optional archivo As String)
  On Error GoTo LineaError
  Dim NameArchivo As String
  Dim sFullName As String
  Dim fso, MyFile, fsoFull, MyFileFull
  Dim fila As Integer
  Dim lenBloque As Long
  
  If Trim(archivo) = "" Then
    archivo = "textfile"
  End If
  
  NameArchivo = "C:\temp\" + Trim(archivo) + ".prn"
  sFullName = "C:\temp\" + Trim(archivo) + "_" + Format(Now(), "ddmmyyyy") + ".prn"
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  Set fsoFull = CreateObject("Scripting.FileSystemObject")
  Set MyFileFull = fsoFull.CreateTextFile(sFullName, True)
  
  For fila = 0 To bloques
    Set MyFile = fso.CreateTextFile(NameArchivo, True)
    
    If fila = 0 Then
      MyFile.WriteLine (Chr$(27) + Chr$(64))
      MyFileFull.WriteLine (Chr$(27) + Chr$(64))
    End If
    
    MyFile.WriteLine (sImprimir(fila))
    MyFileFull.WriteLine (sImprimir(fila))
    
    If fila = bloques Then
      MyFile.WriteLine (vbCrLf)
      MyFile.WriteLine (vbCrLf)
      MyFile.WriteLine (vbCrLf)
      MyFile.WriteLine (vbCrLf)
      MyFile.WriteLine (Chr$(29) + Chr$(86) + Chr$(1))
      
      MyFileFull.WriteLine (vbCrLf)
      MyFileFull.WriteLine (vbCrLf)
      MyFileFull.WriteLine (vbCrLf)
      MyFileFull.WriteLine (vbCrLf)
      MyFileFull.WriteLine (Chr$(29) + Chr$(86) + Chr$(1))
    End If
    
    MyFile.Close

    Set MyFile = fso.GetFile(NameArchivo)
    
    EscribirLog ("p:" & CStr(p) & ";kPAR_IMPRESORA:" & kPAR_IMPRESORA & ";printer.Port:" & CStr(printer.Port) & ";psPuertoPrint:" & LeerCfg("PARAMETROS", "PuertoPrinter", psArchivoCfg) & ";")
    
    If p = 1 Then
      If Left(kPAR_IMPRESORA, 1) <> "\" Then
        If Left(printer.Port, 3) = "COM" Then
          Shell "cmd.exe /c TYPE " & NameArchivo & " > " & printer.Port
        Else
          psPuertoPrint = LeerCfg("PARAMETROS", "PuertoPrinter", psArchivoCfg)
          If psPuertoPrint = "" Then
            MyFile.Copy ("LPT1")
          Else
            MyFile.Copy (psPuertoPrint)
          End If
        End If
      Else
        MyFile.Copy (kPAR_IMPRESORA)
      End If
    Else
      If Left(kPAR_IMPRESORA, 1) <> "\" Then
        If Left(printer.Port, 3) = "COM" Then
          Shell "cmd.exe /c TYPE " & NameArchivo & " > " & printer.Port
        Else
          Dim lpt As String
          lpt = Left(printer.Port, 4)
          MyFile.Copy lpt
        End If
      Else
         MyFile.Copy (kPAR_IMPRESORA_ALTERNA)
      End If
    End If
    
    'If fila < bloques Then
      lenBloque = ((Len(sImprimir(fila)) \ 150) + 1) * 1000
      Sleep lenBloque
    'End If
  Next
  
  MyFileFull.Close
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub

Public Sub Abre_Gaveta_Dinero(ByVal opc As String)
  On Error Resume Next
  Dim NameArchivo As String
  Dim fso, MyFile
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  NameArchivo = "C:\Temp\textfile.prn"
  
  Set MyFile = fso.CreateTextFile(NameArchivo, True)
  
  Select Case Trim(UCase(opc))
  Case "SAMSUNG"
    Set MyFile = fso.CreateTextFile(NameArchivo, True)
    
    MyFile.WriteLine (Chr(27) & Chr(112) & Chr(48) & Chr(55) & Chr(121))
    MyFile.Close
    Set MyFile = fso.GetFile(NameArchivo)
    MyFile.Copy ("LPT1")
  Case "EPSON"
    MyFile.WriteLine (Chr(27) & Chr(112) & Chr(0) & Chr(25) & Chr(250))
    MyFile.Close
    Set MyFile = fso.GetFile(NameArchivo)
    MyFile.Copy ("LPT1")
  Case "START"
    MyFile.WriteLine (Chr(27) & Chr(7) & Chr(11) & Chr(55) & Chr(7))
    MyFile.Close
    Set MyFile = fso.GetFile(NameArchivo)
    MyFile.Copy ("LPT1")
  End Select
End Sub

Public Function validcampo(lSql As String, txtmsgbox1 As String, txtmsgbox2 As String) As Boolean
  Dim lBUSCA As ADODB.Recordset
  Dim lsw As Boolean
  Set lBUSCA = New ADODB.Recordset
  
  lBUSCA.Open lSql, ADOCnnSQL, adOpenStatic, adLockOptimistic, adCmdText
  If lBUSCA.BOF And lBUSCA.EOF Then
    If Not (txtmsgbox1 = "" Or IsNull(txtmsgbox1)) Then
      MsgBox txtmsgbox1, vbCritical, "No Found"
    End If
    lsw = False
  Else
    If Not (txtmsgbox2 = "" Or IsNull(txtmsgbox2)) Then
      MsgBox txtmsgbox2, vbCritical, "Si Found"
    End If
    lsw = True
  End If
  validcampo = lsw
  lBUSCA.Close
  Set lBUSCA = Nothing
  
End Function

Private Function CargarSerieMaquina(ByVal Tipo As Integer) As String
  Dim ADORS As ADODB.Recordset
  Dim sSQL As String
      
  sSQL = "SELECT nsmr " & _
          "FROM _Tmp1 " & _
          "WHERE prn=" & CStr(Tipo)
          
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  If Not ADORS.EOF Then
    CargarSerieMaquina = LeerCampo(ADORS!nsmr)
    Exit Function
  Else
    CargarSerieMaquina = ""
  End If
  
Salir:
  EscribirLog " No se ha encontrado el codigo de impresora"
End Function

Public Function ObtenerCorrelativo(ByVal printer As Integer) As String
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  Dim lCorrelativo As Long
  lCorrelativo = 0
  sSQL = "SELECT idct + 1 as cod, maxid " & _
         "FROM _tmp1 " & _
         "WHERE prn=" & CStr(printer)
           
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo LineaError
  If Not ADORS.EOF Then
    lCorrelativo = ADORS!cod
    If lCorrelativo > ADORS!maxid Then lCorrelativo = 1
  Else
    lCorrelativo = 1
  End If
  
  sSQL = "UPDATE _tmp1 set idct=" & CStr(lCorrelativo) & " " & _
         "WHERE prn=" & CStr(printer)
  
  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError
  
  ObtenerCorrelativo = Right("000000" & CStr(lCorrelativo), 6)
  
  Exit Function
  
LineaError:
  MsgBox "Error al generar Correlativo de impresion "
  EscribirLog ("Error al generar numeracion correlativa en impresora Cod " + CStr(printer))
End Function



Public Function Aleatorio(Minimo As Long, Maximo As Long) As Long

    Randomize ' inicializar la semilla
    Aleatorio = CLng((Minimo - Maximo) * Rnd + Maximo)
    
End Function

Public Function GenerarNumeroLicencia(valor As Long) As String
Dim sValor As String
Dim longitud As Integer
Dim newCad As String
Dim i As Integer
Dim newVal As Integer

sValor = Trim(Str(valor))
longitud = Len(sValor)

For i = 1 To longitud
    If i Mod 2 <> 0 Then
        newVal = 3
        newCad = newCad + CStr(newVal)
    Else
        newCad = newCad + Mid(sValor, i, 1)
    End If
    
Next

sValor = StrReverse(newCad)

GenerarNumeroLicencia = "OSC-000" + sValor


End Function


Public Function ValidarNumeroLicencia(Valor1 As String, Valor2 As String) As Boolean

Dim val As Long
Dim nlicencia As String

val = CLng(Valor1)

nlicencia = GenerarNumeroLicencia(val)


If nlicencia = Valor2 Then
    ValidarNumeroLicencia = True
Else
    ValidarNumeroLicencia = False
End If


End Function

Public Function RetornarIdLocalToOperacionParalelaFromOperacion(cOperCode As String, dOperFech As String) As String
    Dim STRSQL As String
    Dim iLocal As Integer
    Dim ADORS As ADODB.Recordset
    STRSQL = "select idlocal from operacion where cOperCode=" & cOperCode & " and year(dOperFech)=" & Year(dOperFech) & " and month(dOperFech)=" & Month(dOperFech) & " and day(dOperFech)=" & Day(dOperFech) & ""
    
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, STRSQL, ADORS) Then GoTo LineaError
  
  If Not ADORS.EOF Then
    iLocal = IIf(IsNull(ADORS!idLocal), 0, ADORS!idLocal)
  Else
    iLocal = 0
  End If
  
  RetornarIdLocalToOperacionParalelaFromOperacion = CStr(iLocal)
  
  Exit Function
  
LineaError:
    
    RetornarIdLocalToOperacionParalelaFromOperacion = "0"
    MsgBox Err.Description
End Function

Public Function RetornarIdLocalToOPFromO(cOperCode As String, dOperFech As String) As String
  Dim STRSQL As String
  Dim iLocal As Integer
  Dim ADORS As ADODB.Recordset
  
  STRSQL = "select idlocal from Operacion where cOperCode=" & cOperCode & " and year(dOperFech)=" & Year(dOperFech) & " and month(dOperFech)=" & Month(dOperFech) & " and day(dOperFech)=" & Day(dOperFech) & ""
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, STRSQL, ADORS) Then GoTo LineaError
  
  If Not ADORS.EOF Then
    iLocal = IIf(IsNull(ADORS!idLocal), 0, ADORS!idLocal)
  Else
    STRSQL = "select idlocal from Operacion_Historico where cOperCode=" & cOperCode & " and year(dOperFech)=" & Year(dOperFech) & " and month(dOperFech)=" & Month(dOperFech) & " and day(dOperFech)=" & Day(dOperFech) & ""
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, STRSQL, ADORS) Then GoTo LineaError
    
    If Not ADORS.EOF Then
      iLocal = IIf(IsNull(ADORS!idLocal), 0, ADORS!idLocal)
    Else
      iLocal = 0
    End If
  End If
  
  RetornarIdLocalToOPFromO = CStr(iLocal)
  
  Exit Function
  
LineaError:
    RetornarIdLocalToOPFromO = "0"
    MsgBox Err.Description
End Function
