VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form f_recepcion 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Recepcion  de Informacion (95.160.00)"
   ClientHeight    =   5895
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9465
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   5895
   ScaleWidth      =   9465
   Begin MSComDlg.CommonDialog CD_OPEN 
      Left            =   2520
      Top             =   5040
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DefaultExt      =   "RAR"
      DialogTitle     =   "Archvio Para Importacion"
      Filter          =   "RAR"
      InitDir         =   "c:\"
   End
   Begin TabDlg.SSTab SSTab1 
      Height          =   5835
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   9435
      _ExtentX        =   16642
      _ExtentY        =   10292
      _Version        =   393216
      Tabs            =   1
      TabHeight       =   520
      TabCaption(0)   =   "Recepcion de Informacion"
      TabPicture(0)   =   "9516000.frx":0000
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "Label4"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).Control(1)=   "Label3"
      Tab(0).Control(1).Enabled=   0   'False
      Tab(0).Control(2)=   "Label2"
      Tab(0).Control(2).Enabled=   0   'False
      Tab(0).Control(3)=   "Label1"
      Tab(0).Control(3).Enabled=   0   'False
      Tab(0).Control(4)=   "Label5"
      Tab(0).Control(4).Enabled=   0   'False
      Tab(0).Control(5)=   "pgb_avance"
      Tab(0).Control(5).Enabled=   0   'False
      Tab(0).Control(6)=   "TXT_SITE"
      Tab(0).Control(6).Enabled=   0   'False
      Tab(0).Control(7)=   "Txt_tabla"
      Tab(0).Control(7).Enabled=   0   'False
      Tab(0).Control(8)=   "Txt_archivo"
      Tab(0).Control(8).Enabled=   0   'False
      Tab(0).Control(9)=   "Opt_centralestacion"
      Tab(0).Control(9).Enabled=   0   'False
      Tab(0).Control(10)=   "Opt_estacioncentral"
      Tab(0).Control(10).Enabled=   0   'False
      Tab(0).Control(11)=   "lst_tablas"
      Tab(0).Control(11).Enabled=   0   'False
      Tab(0).Control(12)=   "Cmd_salir"
      Tab(0).Control(12).Enabled=   0   'False
      Tab(0).Control(13)=   "cmd_aceptar"
      Tab(0).Control(13).Enabled=   0   'False
      Tab(0).Control(14)=   "CMD_SELEC_FILE"
      Tab(0).Control(14).Enabled=   0   'False
      Tab(0).Control(15)=   "TXT_AVANCE"
      Tab(0).Control(15).Enabled=   0   'False
      Tab(0).Control(16)=   "cmd_reporte"
      Tab(0).Control(16).Enabled=   0   'False
      Tab(0).Control(17)=   "txtdirecotio"
      Tab(0).Control(17).Enabled=   0   'False
      Tab(0).ControlCount=   18
      Begin VB.TextBox txtdirecotio 
         Height          =   360
         Left            =   4260
         Locked          =   -1  'True
         TabIndex        =   18
         Top             =   480
         Width           =   3855
      End
      Begin VB.CommandButton cmd_reporte 
         Caption         =   "Reporte"
         Height          =   795
         Left            =   4080
         Picture         =   "9516000.frx":001C
         Style           =   1  'Graphical
         TabIndex        =   16
         Top             =   4920
         Visible         =   0   'False
         Width           =   1095
      End
      Begin VB.TextBox TXT_AVANCE 
         Enabled         =   0   'False
         Height          =   315
         Left            =   6780
         TabIndex        =   15
         Top             =   1980
         Visible         =   0   'False
         Width           =   2355
      End
      Begin VB.CommandButton CMD_SELEC_FILE 
         Caption         =   "Exportar"
         Height          =   495
         Left            =   8280
         Picture         =   "9516000.frx":0326
         Style           =   1  'Graphical
         TabIndex        =   14
         Top             =   420
         Width           =   795
      End
      Begin VB.CommandButton cmd_aceptar 
         Caption         =   "Exportar"
         Height          =   795
         Left            =   480
         Picture         =   "9516000.frx":0470
         Style           =   1  'Graphical
         TabIndex        =   9
         Top             =   4920
         Width           =   1095
      End
      Begin VB.CommandButton Cmd_salir 
         Cancel          =   -1  'True
         Caption         =   "Salir"
         Height          =   795
         Left            =   8160
         Picture         =   "9516000.frx":077A
         Style           =   1  'Graphical
         TabIndex        =   8
         Top             =   4920
         Width           =   1095
      End
      Begin VB.ListBox lst_tablas 
         Height          =   2400
         Left            =   120
         TabIndex        =   7
         Top             =   2400
         Width           =   9195
      End
      Begin VB.OptionButton Opt_estacioncentral 
         Caption         =   "Estacion a Central"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Left            =   240
         TabIndex        =   6
         Top             =   480
         Value           =   -1  'True
         Width           =   2595
      End
      Begin VB.OptionButton Opt_centralestacion 
         Caption         =   "Central a Estacion"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Left            =   240
         TabIndex        =   5
         Top             =   840
         Width           =   2595
      End
      Begin VB.TextBox Txt_archivo 
         Height          =   360
         Left            =   4260
         Locked          =   -1  'True
         TabIndex        =   4
         Top             =   840
         Width           =   3905
      End
      Begin VB.TextBox Txt_tabla 
         Height          =   360
         Left            =   4260
         Locked          =   -1  'True
         TabIndex        =   3
         Top             =   1200
         Width           =   4875
      End
      Begin VB.TextBox TXT_SITE 
         Height          =   360
         Left            =   4260
         Locked          =   -1  'True
         TabIndex        =   1
         Top             =   1560
         Width           =   4875
      End
      Begin MSComctlLib.ProgressBar pgb_avance 
         Height          =   315
         Left            =   180
         TabIndex        =   2
         Top             =   1980
         Visible         =   0   'False
         Width           =   6555
         _ExtentX        =   11562
         _ExtentY        =   556
         _Version        =   393216
         Appearance      =   1
      End
      Begin VB.Label Label5 
         Caption         =   "Directorio"
         Height          =   255
         Left            =   2880
         TabIndex        =   17
         Top             =   550
         Width           =   1095
      End
      Begin VB.Label Label1 
         Caption         =   "Fecha Proceso:"
         Height          =   315
         Left            =   360
         TabIndex        =   13
         Top             =   1440
         Width           =   1215
      End
      Begin VB.Label Label2 
         Caption         =   "Archivo Fuente:"
         Height          =   255
         Left            =   2880
         TabIndex        =   12
         Top             =   900
         Width           =   1215
      End
      Begin VB.Label Label3 
         Caption         =   "Tabla en Proceso:"
         Height          =   255
         Left            =   2880
         TabIndex        =   11
         Top             =   1260
         Width           =   1395
      End
      Begin VB.Label Label4 
         Caption         =   "Site en Proceso:"
         Height          =   255
         Left            =   2880
         TabIndex        =   10
         Top             =   1620
         Width           =   1215
      End
   End
End
Attribute VB_Name = "F_RECEPCION"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim rsexiste As ADODB.Recordset
Dim Blnexiste As Boolean

Dim mobj_recepcion As lib_trasmision.Cls_recepcion
Dim mobj_gen As lib_trasmision.Cls_general

Dim str_archivo As String
Dim WithEvents RSDESTINO As ADODB.Recordset
Attribute RSDESTINO.VB_VarHelpID = -1
Dim rs_sites As ADODB.Recordset
Dim mstr_site As String
Dim mstr_ruta As String
Dim mstr_nombresite As String
Dim mobj_sites As DB_INV_MANTENIMIENTOS.C_ALMACEN
Dim dbs As Database
Dim str_bd As String    'nombre de la base de datos
Dim GCUSERID As String


Public LstrDirectorio As String

Public pb_editar As Boolean
Public pb_agregar As Boolean
Public pb_primerregistro As Boolean
Public pb_ultimoregistro As Boolean
Public pbderecho_agregar As Boolean
Public pbderecho_consultar As Boolean
Public pbderecho_editar As Boolean
Public pbderecho_borrar As Boolean
Public pbderecho_imprimir As Boolean
Public pbderecho_anular As Boolean
Public pbderecho_emitir As Boolean
Public pb_tiposcreen As String
Private Sub CMD_ACEPTAR_Click()

Dim fs, f, f1, f2, fc, s
Dim nombretabla As String
Dim tabladestino As String
Dim idtabla As String
Dim ntablas As Integer
Dim i As Integer
Dim LstrBaseDatos As String

Dim Lintcuentazip As Integer
Dim Lintcuentamdb As Integer

str_bd = str_archivo

Dim rs_tablasrecepcion As ADODB.Recordset
Dim lstr_tabla As String

'If Len(Trim(str_bd)) = 0 Then
'    MsgBox "Debe Escoger un archivo para procesar", vbExclamation, "No se ha Seleccionado un Archivo"
'    Exit Sub
'End If

If GintCentralEstacion = 1 Then
   Opt_centralestacion.Value = False
   Opt_estacioncentral.Value = True
Else
   If GintCentralEstacion = 0 Then
      Opt_centralestacion.Value = True
      Opt_estacioncentral.Value = False
   End If
End If

'********************************************************************************************************

 Set fs = CreateObject("Scripting.FileSystemObject")
 
 If Trim(LstrDirectorio) = "" Then
    MsgBox "Debe seleccionar un directorio", vbDefaultButton1 + vbExclamation, "Mensaje"
    Exit Sub
 End If
 
 Set f = fs.GetFolder(LstrDirectorio)
 Set fc = f.Files

 ' Barrido para UNZIP
 Dim Lstrrutaunzip As String
 Dim StrCadZip As String
 
 Lintcuentazip = 0
 
 For Each f2 In fc
    If UCase(Right(Trim(f2.Name), 3)) = "ZIP" Then
       Lintcuentazip = Lintcuentazip + 1
       If Right(LstrDirectorio, 1) = "\" Then
          Lstrrutaunzip = LstrDirectorio
       Else
          Lstrrutaunzip = LstrDirectorio + "\"
       End If

       StrCadZip = "c:\pkunzip " & Lstrrutaunzip + f2.Name + " " + Lstrrutaunzip
       Shell (StrCadZip), vbHide
    End If
 Next
 
 Lintcuentamdb = 0
 
 Do While Lintcuentazip <> Lintcuentamdb
    Lintcuentamdb = 0
    For Each f1 In fc
       If UCase(Right(Trim(f1.Name), 3)) = "MDB" Then
          Lintcuentamdb = Lintcuentamdb + 1
       End If
       
       If UCase(Right(Trim(f1.Name), 3)) <> "MDB" And UCase(Right(Trim(f1.Name), 3)) <> "ZIP" Then
          MsgBox "El archivo " & Trim(f1.Name) & " es incorrecto", vbDefaultButton1 + vbExclamation, "Mensaje"
          Exit Sub
       End If
    Next
 Loop

 Dim fsoTemp, txtfiletemp


 If Opt_estacioncentral.Value = True Then
 
    Set fsoTemp = CreateObject("Scripting.FileSystemObject")
    
    Set txtfiletemp = fsoTemp.CreateTextFile(Trim(Gstrarchivoaudita), True, True)
    Dim Lstraster As String
    Lstraster = "*********************************************************************************************************************************************************"

    txtfiletemp.WriteLINE (Lstraster)
    txtfiletemp.WriteLINE (Space(45) & "Reporte de Auditoria de recepción de información en Central")
    txtfiletemp.WriteLINE ("")
    txtfiletemp.WriteLINE ("Fecha:" & Now)
    txtfiletemp.WriteLINE (Lstraster)
    txtfiletemp.WriteLINE (Space(9) & "Site           " & "        Fecha actual         " & Space(21) & "Fecha Creación         " & Space(17) & "Fecha Proceso      ")
    txtfiletemp.WriteLINE (Lstraster)
 End If
 
 For Each f1 In fc
     If UCase(Right(Trim(f1.Name), 3)) <> "MDB" Then
        GoTo AVANZA
     End If
 
     str_bd = f1.Name
     Txt_archivo.Text = f1.Name
     mstr_site = Mid(f1.Name, 1, 2)
     
     ' Parte que graba en un Archivo TXT
             
             If Opt_estacioncentral.Value = True Then
                                                                
                txtfiletemp.WriteLINE (Space(9) & (Mid(f1.Name, 1, 2) + Space(20) & Now & Space(20) & CStr(FileDateTime(Lstrrutaunzip & f1.Name)) & Space(20) + Mid(Mid(f1.Name, 3, 6), 1, 2) & "/" & Mid(Mid(f1.Name, 3, 6), 3, 2) & "/" & Mid(Mid(f1.Name, 3, 6), 5, 2)))
            
             End If
             
     ' Fin de parte que graba en un Archivo TXT
     
     lst_tablas.AddItem "***************************************************"
     lst_tablas.AddItem "*******    Procesando Site " & mstr_site & "  **************"
     lst_tablas.AddItem "***************************************************"
     
     mstr_nombresite = mobj_sites.ObtenerDescripcionAlmacen(mstr_site)
     TXT_SITE.Text = mstr_site + " " + mstr_nombresite
     TXT_SITE.Refresh
            
     If Right(LstrDirectorio, 1) = "\" Then
        LstrBaseDatos = LstrDirectorio + f1.Name
     Else
        LstrBaseDatos = LstrDirectorio + "\" + f1.Name
     End If
            
            
     Set dbs = OpenDatabase(LstrBaseDatos)
     'Set rs_fuente = New DAO.TableDef
     ntablas = dbs.TableDefs.Count
     Set rs_tablasrecepcion = mobj_gen.tablasrecepcion
     
            Do While Not rs_tablasrecepcion.EOF
                lstr_tabla = rs_tablasrecepcion!TableId
                
                For i = 0 To ntablas - 1
                    nombretabla = dbs.TableDefs(i).Name
                    tabladestino = Mid(dbs.TableDefs(i).Name, 5)
                    idtabla = Mid(dbs.TableDefs(i).Name, 1, 3)
                    
                    If lstr_tabla = idtabla Then
                    
                        'If mobj_recepcion.existemetatabla(idtabla) Then
                        
                        If mobj_gen.existetabla(tabladestino) Then
                            Txt_tabla.Text = nombretabla
                            Me.Refresh
                            Call importacion(nombretabla, tabladestino, idtabla)
                        Else    'no existe tabla destino
                            lst_tablas.AddItem "!!!! " + nombretabla + " No Existe en bd Destino"
                        End If
                        lst_tablas.ListIndex = lst_tablas.ListCount - 1
                    
                    'Else    ' NO EXISTE META DATA
                    '    lst_tablas.AddItem "!!!! " + nombretabla + " No Existe Meta Data"
                    '    lst_tablas.ListIndex = lst_tablas.ListCount - 1
                    'End If
                    End If
                Next
                rs_tablasrecepcion.MoveNext
            Loop
     Dim fso
     Dim LstrRutarecepHisto As String

     If Right(GstrRutaHistoricaRecep, 1) = "\" Then
        LstrRutarecepHisto = GstrRutaHistoricaRecep
     Else
        LstrRutarecepHisto = GstrRutaHistoricaRecep + "\"
     End If

     Set fso = CreateObject("Scripting.FileSystemObject")
     fso.copyfile LstrBaseDatos, LstrRutarecepHisto + str_bd
                                      
     Set rs_tablasrecepcion = Nothing
     
AVANZA:
    
 Next
  
 If Opt_estacioncentral.Value = True Then
    txtfiletemp.Close
 End If
 
 If Opt_centralestacion.Value = True Then

   Dim lcmd As ADODB.Command
   Dim lcn As ADODB.Connection
        
   Set lcn = New ADODB.Connection
   Set lcmd = New ADODB.Command
   
   lcn.ConnectionString = "DSN=SIES;UID=sa;PWD="
   lcn.Open
       
   lcmd.ActiveConnection = lcn
   lcmd.CommandText = "AR_Actualiza_Saldo_ClienteProc "
   lcmd.Execute
          
   Set lcn = Nothing
   Set lcmd = Nothing
          
 End If

 '***************************************************
 Set dbs = Nothing
 MsgBox "Proceso Concluido", vbInformation, "OK"
                                                                                                                                                    
End Sub

Sub importacion(ByVal tablafuente As String, ByVal lstr_tabladestino As String, _
                ByVal idtabla As String)

Dim rs_fuente As DAO.Recordset      'rs access
Dim rs_destino As ADODB.Recordset   'recordset sql
Dim rs_meta As ADODB.Recordset   'recordset de metadata de la tabla
Dim cadenaconexion As String
Dim rs_pk As ADODB.Recordset    'recordset para recibir el primary key de una tabla
Dim LSTR_PK As String   'CADENA PARA CONSTRUIR LA BUSQUEDA POR LA LLAVE PRIMARIA
Dim CADENA As String
Dim NCAMPOS As Integer  'numero de campos
Dim nombrecampo As String 'nombre del campo
Dim i As Long
Dim W As Long
Dim StrSql As String
Dim nregistros As Long
Dim nuevos As Long
Dim actualizados As Long

Dim LSTR_CADENABUSQUEDA As String
Dim con  As ADODB.Connection
Dim cadenacon As String 'cadena de conexion
Dim LSTR_CAMPOFECHA As String
Dim LSTR_FECHA As String
Dim LSTR_TIPOTABLA As String
Dim li_nreg As Long 'numero de registros

Dim LintCentralEstacion As Integer
Dim LintEstacionCentral As Integer

'************************************************
 
 Dim MConImport  As ADODB.Connection
 Dim MRsImport   As ADODB.Recordset
 Dim MCmdImport  As ADODB.Command


 Set MConImport = New ADODB.Connection
 Set MRsImport = New ADODB.Recordset
 Set MCmdImport = New ADODB.Command
 MConImport.ConnectionString = "DSN=SIES"
 MConImport.Open
 
'************************************************
  
 Dim DblDeuda As Double
 Dim VarTsStamp As Variant
 Dim StrMonedaCliente As String
 Dim Rs_AR_CCDOC As DAO.Recordset
 Dim DblMontoaFavor As Double
   
'************************************************

'On Error GoTo trataerror

CADENA = "select * from [" + tablafuente + "]"

If Opt_estacioncentral.Value = True Then
   If RTrim(LTrim(tablafuente)) = "010-CUSTOMER" Then
      CADENA = "select * from [" + tablafuente + "] where CUSTCLASSID not in ('01','02','03') "
   End If
End If

Set rs_fuente = dbs.OpenRecordset(CADENA, dbOpenDynaset)

'Set db = New ADODB.Connection
        
lstr_tabladestino = Mid(tablafuente, 5)

Set rs_meta = mobj_gen.meta_tabla(idtabla)
'-----------------------------------------------------------
'On Error GoTo trataerror

LintCentralEstacion = IIf(rs_meta!CENTRAL_TO_STATION, 1, 0)
LintEstacionCentral = IIf(rs_meta!STATION_TO_CENTRAL, 1, 0)


LSTR_TIPOTABLA = rs_meta!Type
Select Case LSTR_TIPOTABLA

    Case "T"
        'PARA LAS TABLAS DE TRANSACCIONES PEDIR ESTRUCTURAS VACIAS
        'POR QUE SOLO SE VAN A INSERTAR DATOS
        StrSql = " SELECT * FROM " + lstr_tabladestino + " WHERE 1=2"
    Case "M"
        'PARA LAS TABLAS DE MAESTRAS PEDIR TODOS LOS REGISTROS PARA BUSCARLOS
        'POR QUE SOLO SE VAN A MODIFICAR E INSERTAR DATOS
        
        'If rs_meta!PERSITE Then    'SI ES UNA MAESTRA ESPECIFICA POR SITE PEDIR SOLO ESOS DATOS
        '    StrSql = " SELECT * FROM " + lstr_tabladestino + " WHERE SITEID='" + mstr_site + "'"
        'Else
        '    StrSql = " SELECT * FROM " + lstr_tabladestino
        'End If
    
        StrSql = " SELECT * FROM " + lstr_tabladestino + " WHERE 1=2 "
    Case "S"
        'PARA LAS TABLAS DE SISTEMAS SE DEBEN ACTUALIZAR TODOS LOS CAMPOS
        StrSql = " SELECT * FROM " + lstr_tabladestino
    Case Else
        lst_tablas.AddItem "!! " + lstr_tabladestino + " Marcada para no Transferencia "
        Exit Sub
End Select


'cadenacon = "FILEDSN=conexionsies"
'cadenacon = "DSN=SIES"


If GintCentralEstacion = 1 Then
  cadenacon = "FILEDSN=conexionsies"
Else
  cadenacon = "DSN=SIES"
End If


Set con = New ADODB.Connection
con.Open cadenacon

Set rs_destino = New ADODB.Recordset
rs_destino.CursorLocation = adUseClient
'rs_destino.Open StrSql,cadenacon  , adOpenKeyset, adLockOptimistic
rs_destino.Open StrSql, con, adOpenDynamic, adLockOptimistic
'-----------------------------------------------------------
        
Set rs_pk = mobj_recepcion.obtenerpk(lstr_tabladestino)

If rs_fuente.RecordCount > 0 Then
If lstr_tabladestino = "IN_INTRAHEAD" Then
    'MsgBox "AQUI VAMOS"
End If

    NCAMPOS = rs_fuente.Fields.Count

    'VERIFICAR QUE LOS NOMBRES Y LOS TIPOS DE CAMPOS COINCIDAN
        For i = 0 To NCAMPOS - 1  'pasar los campos
            If UCase(rs_fuente.Fields(i).Name) <> UCase(rs_destino.Fields(i).Name) Then
                MsgBox "Existen Campos Con Nombres diferentes" + Chr(13) + _
                        "Tabla        :" + lstr_tabladestino + Chr(13) + Chr(13) + _
                        "Campo Origen :" + rs_fuente.Fields(i).Name + Chr(13) + _
                        "Campo Destino:" + rs_destino.Fields(i).Name, vbExclamation, "Estructuras Diferentes"
             
                lst_tablas.AddItem lstr_tabladestino + " Estructuras Diferentes"
                Exit Sub
            End If
        Next
            
    'ASIGNAR LOS DATOS CAMPO X CAMPO
    'rs_fuente.MoveFirst
    nregistros = 0
    
    'VERIFICAR QUE NO EXISTAN DOCUMENTOS CON ESA FECHA
     If rs_meta!Type = "T" Then    ' SI ES TRANSACCION BUSCAR UNA SOLA VEZ LA FECHA
         LSTR_CAMPOFECHA = rs_meta!DATEFIELD
         LSTR_FECHA = CStr(rs_fuente.Fields(LSTR_CAMPOFECHA).Value)
         If mobj_recepcion.EXISTEDATOSFECHATRANSACCION(lstr_tabladestino, LSTR_CAMPOFECHA, LSTR_FECHA, mstr_site) Then    ' la busqueda se hace en el servidor
             lst_tablas.AddItem "!! " + lstr_tabladestino + " Ya existen datos con la fecha de proceso "
             'If Opt_estacioncentral.Value = True Then
                 'Exit Sub
             'End If
         End If
     End If
       
    'con.BeginTrans      INICIAR UNA TRANSACCION

    pgb_avance.Visible = True
    txt_avance.Visible = True
    pgb_avance.Value = 0
    rs_fuente.MoveLast
    
    li_nreg = rs_fuente.RecordCount
    rs_fuente.MoveFirst
    Do While Not rs_fuente.EOF
            
        'SE DEBE CONSTRUIR LA CADENA PARA BUSCAR POR LA LLAVE PRIMARIA
        LSTR_PK = CADENAPK(rs_fuente, rs_destino, rs_pk)
        
        'LSTR_CADENABUSQUEDA = "SELECT TOP 1 * FROM " + lstr_tabladestino + " WHERE " + LSTR_PK
        
        If (LintCentralEstacion = 1 Or LintEstacionCentral = 1) And rs_meta!Type = "T" Then
           ' Si es una Tabla que es enviada de estacion como Transacción a Central (Es por fecha de proceso )
           ' y si es de Central a estacion se trata como una Maestra (por que no hay fecha de proceso en Central)
           ' siempre y cuando sea de doble via
           If Opt_centralestacion.Value = True Then
              GoTo TRATAR_COMO_MAESTRA
           End If
        End If
        
        If rs_meta!Type = "T" Then
        'SI ES UNA TRANSACCION SE AGREGA
        
            If (nregistros Mod 2000 = 0) And nregistros > 0 Then
                    StrSql = " SELECT * FROM " + lstr_tabladestino + " WHERE 1=2"
 '                   rs_destino.Update
                    rs_destino.Close
                    rs_destino.Open StrSql, con, adOpenDynamic, adLockOptimistic
            End If
            
            rs_destino.AddNew
            nuevos = nuevos + 1
        End If

        If rs_meta!Type = "M" Then  'SI ES MAESTRA, SE PUEDE AGREGAR O MODIFICAR
            
TRATAR_COMO_MAESTRA:
            'If rs_fuente!STKNEW Then     'AGREGAR
            '    rs_destino.AddNew
            
           ' If rs_fuente!STKMODIFY Or rs_fuente!STKNEW Then   'hay que buscarlo
                
                'rs_destino.Update
                
                If rs_meta!PERSITE Then    'SI ES UNA MAESTRA ESPECIFICA POR SITE PEDIR SOLO ESOS DATOS
                
                  If UCase(Trim(lstr_tabladestino)) = "IN_KDXHIST" Then
                    StrSql = " SELECT * FROM " + lstr_tabladestino + " (INDEX=PK__IN_KDXHIST) WHERE SITEID='" + mstr_site + "' AND " + LSTR_PK
                  Else
                    StrSql = " SELECT * FROM " + lstr_tabladestino + " WHERE SITEID='" + mstr_site + "' AND " + LSTR_PK
                  End If
                Else
                  StrSql = " SELECT * FROM " + lstr_tabladestino + " WHERE " + LSTR_PK
                End If
                
'               rs_destino.Update
                
                rs_destino.Close

                rs_destino.Open StrSql, con, adOpenDynamic, adLockOptimistic
                
                'rs_destino.Filter = LSTR_PK
                
                If rs_destino.EOF Then 'NO EXISTE,
                    rs_destino.AddNew
                    nuevos = nuevos + 1
                Else
                  If UCase(Trim(lstr_tabladestino)) = "CUSTOMER" Then
                    If Trim(rs_destino!CUSTCLASSID) = "01" Or Trim(rs_destino!CUSTCLASSID) = "02" Or Trim(rs_destino!CUSTCLASSID) = "03" Then
                       GoTo AVANZA
                    End If
                  End If
                    actualizados = actualizados + 1
                End If
                
            'End If
        End If
       
       'ACTUALIZAR
        
       If Not rs_destino.EOF Then
                
        '********************************************************************
        ' Nueva Parte Anexada
         
         If rs_meta!Type = "T" Then
         
            Blnexiste = False
            Set rsexiste = New ADODB.Recordset
            
            If UCase(Trim(lstr_tabladestino)) = "INTRAMOV" Then
               rsexiste.Open "Select * from  " & lstr_tabladestino & " (INDEX=PK_INTRAMOV) Where " & LSTR_PK, "DSN=SIES"
            Else
               If UCase(Trim(lstr_tabladestino)) = "IN_KDXHIST" Then
                  rsexiste.Open "Select * from  " & lstr_tabladestino & " (INDEX=PK__IN_KDXHIST) Where " & LSTR_PK, "DSN=SIES"
               Else
                  rsexiste.Open "Select * from  " & lstr_tabladestino & " Where " & LSTR_PK, "DSN=SIES"
               End If
            End If
                                           
            If rsexiste.EOF Then
               Blnexiste = False
            Else
               Blnexiste = True
                'Parte Agregada el 11-05-2004
                    If UCase(Trim(lstr_tabladestino)) = "AR_CCDOC" Then
                       rs_destino.CancelUpdate
                       rs_destino.Close
                       rs_destino.Open "Select * from  " & lstr_tabladestino & " Where " & LSTR_PK, con, adOpenDynamic, adLockOptimistic
                    End If
                'Parte Agregada el 11-05-2004
            End If
         End If
        ' Nueva Parte Anexada
        
        For i = 0 To NCAMPOS - 1  'pasar los campos
            'if not timestamp
                nombrecampo = UCase(rs_fuente.Fields(i).Name)
                
                If rs_meta!CENTRAL_TO_STATION = True And rs_meta!STATION_TO_CENTRAL = True Then
                   Select Case nombrecampo
                      'Case "STKRECEIVE"
                      '      rs_destino.Fields(i).Value = 1
                      Case "STKSEND", "STKNEW", "STKMODIFY", "STKRECEIVE"
                            rs_destino.Fields(i).Value = 0
                      Case Else
                            Select Case rs_destino.Fields(i).Name
                                Case "CURRBAL"
                                        If Opt_centralestacion.Value = True Then
                                        
                                             MRsImport.Open "Select CURRBAL,TSTAMP from op_cust_limit where " & LSTR_PK, MConImport, adOpenStatic
                                             DblDeuda = MRsImport!CURRBAL
                                             VarTsStamp = MRsImport!TSTAMP
                                             MRsImport.Close
                                             MRsImport.Open " Select CURYID from customer where CUSTIDSS='" & rs_fuente("CUSTIDSS").Value & "'", MConImport, adOpenStatic
                                             StrMonedaCliente = MRsImport!curyid
                                             
                                             ' Hay que Obtener los Pagos Agrupados por Almacen
                                                                                                                                       
                                             Set Rs_AR_CCDOC = dbs.OpenRecordset( _
                                                              " SELECT SITEID,SUM(PAIDMENTPEN) AS PAGOBASE," & _
                                                              " SUM(PAIDMENTUSD) As PAGOEXT From [002-AR_CCDOCDET] " & _
                                                              " WHERE SITEID='" & mstr_site & "' and (stknew or stkmodify) " & _
                                                              " GROUP BY SITEID ", dbOpenDynaset)
                                                                                                                                                                             
                                            If Not Rs_AR_CCDOC.EOF Then
                                               If GstrCodMonedaBase = StrMonedaCliente Then
                                                  DblMontoaFavor = Rs_AR_CCDOC!PAGOBASE
                                               Else
                                                  DblMontoaFavor = Rs_AR_CCDOC!PAGOEXT
                                               End If
                                             Else
                                               DblMontoaFavor = 0
                                             End If
                                            ' ------------------------------------------------
                                            
                                           If DblMontoaFavor <> 0 Then
                                            
                                               'MCmdImport.ActiveConnection = con
                                               'MCmdImport.CommandText = " Update OP_CUST_LIMIT SET CURRBAL=CURRBAL - " & DblMontoaFavor & _
                                               '                         " WHERE " & LSTR_PK
                                               'MCmdImport.Execute
                                               
                                               rs_destino.Fields(i).Value = rs_destino.Fields(i).Value - DblMontoaFavor
                                            End If
                                            ' ------------------------------------------------
                                            rs_fuente.Edit
                                            rs_fuente.Fields("STKNEW") = 0
                                            rs_fuente.Fields("STKMODIFY") = 0
                                            rs_fuente.Update
                                            
                                            ' ------------------------------------------------
                                            
                                            MRsImport.Close
                                         Else
                                            rs_destino.Fields(i).Value = rs_fuente.Fields(i).Value
                                         End If
                                Case Else
                                         rs_destino.Fields(i).Value = rs_fuente.Fields(i).Value
                            End Select
                    End Select
                Else
                   
                    If rs_meta!Type = "T" Then
                       
                       ' Aqui se tiene que Meter
                         
                         ' Hay que Preguntar si existe
                         
                            'Blnexiste = False
                                                        
                            'Set rsexiste = New ADODB.Recordset
                            'rsexiste.Open "Select * from  " & lstr_tabladestino & " Where " & LSTR_PK, "DSN=SIES"
                               
                            'If rsexiste.EOF Then
                            '   Blnexiste = False
                            'Else
                            '   Blnexiste = True
                            'End If
                            
                         ' Fin de Pregunta si Existe
                            
                            Select Case nombrecampo
                              Case "STKRECEIVE"
                                   rs_destino.Fields(i).Value = 1
                              Case "STKSEND", "STKNEW", "STKMODIFY"
                                   rs_destino.Fields(i).Value = 0
                              Case Else
                                   rs_destino.Fields(i).Value = rs_fuente.Fields(i).Value
                            End Select
                                                     
                         ' Fin de Preguntar si existe
                                              
                       ' Fin de se Tiene que Meter
                       
                    Else
                        Select Case nombrecampo
                            Case "STKRECEIVE"
                                 rs_destino.Fields(i).Value = 1
                            Case "STKSEND", "STKNEW", "STKMODIFY"
                                 rs_destino.Fields(i).Value = 0
                            Case Else
                                 If Trim(lstr_tabladestino) = "IN_INVENTORYDAT" Then
                                    ' Solo se filtran algunos campos porque central no puede tocar el stock
                                    ' de las estaciones
                                    'If UCase(nombrecampo) = "SLS_PRICE" Or UCase(nombrecampo) = "INVTIDSTK" Or UCase(nombrecampo) = "INVTIDNOSTK" Or UCase(nombrecampo) = "USER4" Or UCase(nombrecampo) = "USER5" Then
                                    '   rs_destino.Fields(i).Value = rs_fuente.Fields(i).Value
                                    'End If
                                                                        
                                    If UCase(nombrecampo) = "SLS_PRICE" Or _
                                       UCase(nombrecampo) = "INVTIDSTK" Or _
                                       UCase(nombrecampo) = "INVTIDNOSTK" Or _
                                       UCase(nombrecampo) = "USER4" Or _
                                       UCase(nombrecampo) = "USER5" Or _
                                       UCase(nombrecampo) = "INVTIDSKU" Or _
                                       UCase(nombrecampo) = "SITEID" Or _
                                       UCase(nombrecampo) = "STOCKMIN" Or _
                                       UCase(nombrecampo) = "STOCKMAX" Or _
                                       UCase(nombrecampo) = "PRECLVID" Then
                                       rs_destino.Fields(i).Value = rs_fuente.Fields(i).Value
                                    End If

                                 Else
                                     rs_destino.Fields(i).Value = rs_fuente.Fields(i).Value
                                 End If
                                 ' Hay que Añadir que la Conexion a Gasboy
                                 ' Si la Venta es Automatica / si es Gasboy / si es IN_INVENTORYDAT
                                 
                                                                                                                                                                                                    
                                           If GIntVentaAutoCombust = 1 And GintTipoControlador = 0 Then
                                               If UCase(lstr_tabladestino) = UCase("IN_INVENTORYDAT") Then
                                                  If UCase(nombrecampo) = "SLS_PRICE" Then
                                                                                                         
                                                     Dim rsCategoris As ADODB.Recordset
                                                     Set rsCategoris = New ADODB.Recordset
                                                     rsCategoris.Open " Select Classid from in_inventory " & _
                                                                      " where invtidsku='" & rs_destino!INVTIDSKU & "' and Classid in (select CATEGORYFUEL from op_setup)", MConImport
                    
                                                        If Not rsCategoris.EOF Then
                                                     
                                                                 ' Hay que Conectarnos a Gasboy
                                                                 Dim MconGasBoy As ADODB.Connection
                                                                 Dim cmdGasboy As ADODB.Command
                                                                 Dim rsGasboy As ADODB.Recordset
                                                                 Dim rsAlter As ADODB.Recordset
                                                                 Dim Lstrcadena As String
                                                                                                                                                       
                                                                 Set rsGasboy = New ADODB.Recordset
                                                                 Set MconGasBoy = New ADODB.Connection
                                                                 MconGasBoy.ConnectionString = "FILEDSN=gasboy"
                                                                 MconGasBoy.Open
                                                                                                                                  
                                                                 Set cmdGasboy = New ADODB.Command
                                                                 cmdGasboy.ActiveConnection = MconGasBoy
                                                                 
                                                                 rsGasboy.Open "Select count(*) as Cuenta from Price01 ", MconGasBoy
                                                                 
                                                                 If rsGasboy!cuenta < 1 Then
                                                                        cmdGasboy.CommandText = "Insert into Price01(AC,Hora,Fecha) Values (4,'" & _
                                                                                                 Format(rs_fuente.Fields("USER4").Value, "HH:MM") & "',{^" & Format(rs_fuente.Fields("USER4").Value, "YYYY/MM/DD") & "})"
                                                                        cmdGasboy.Execute
                                                                 Else
                                                                        cmdGasboy.CommandText = "Update Price01 set AC=4,Hora='" & Format(rs_fuente.Fields("USER4").Value, "HH:MM") & "'," & _
                                                                                                "Fecha=" & "{^" & Format(rs_fuente.Fields("USER4").Value, "YYYY/MM/DD") & "}"
                                                                        cmdGasboy.Execute
                                                                 End If
                                                                 
                                                                 Set rsAlter = New ADODB.Recordset
                                                                 rsAlter.Open "Select INVTIDBARR from in_inventoryalter where invtidsku='" & rs_destino!INVTIDSKU & "'", MConImport
                                                                    
                                                                 If Not rsAlter.EOF Then
                                                                    If Len(Trim(CStr(rs_fuente.Fields(i).Value))) < 5 Then
                                                                       For W = 1 To 5 - Len(Trim(CStr(rs_fuente.Fields(i).Value)))
                                                                          Lstrcadena = Lstrcadena + "0"
                                                                       Next
                                                                       Lstrcadena = Lstrcadena + Trim(CStr(rs_fuente.Fields(i).Value))
                                                                    Else
                                                                       Lstrcadena = Trim(CStr(rs_fuente.Fields(i).Value))
                                                                    End If
                                                                                                                                        
                                                                    Lstrcadena = CStr(Format(rs_fuente.Fields(i).Value, "0#.00"))
                                                                    
                                                                    cmdGasboy.CommandText = "Insert into Price02(Npr,Pcont,Pcred) Values ('" & Mid(Trim(rsAlter!INVTIDBARR), 2, 1) & "','" & _
                                                                                             Lstrcadena & "','" & Lstrcadena & "')"
                                                                    cmdGasboy.Execute
                                                                 End If
                                                                 
                                                                 Set rsAlter = Nothing
                                                                 Set cmdGasboy = Nothing
                                                                 Set MconGasBoy = Nothing
                                                                                                              
                                                                 ' Fin de Conectranos a Gaboy
                                                        End If
                                                    End If
                                               End If
                                           End If
                                                                             
                                 ' ***************************************
                        End Select
                    End If
                    
                End If
                
                
            'end if
        Next
        
        If rs_meta!Type = "T" Then   ' Si la Tablas es de Tipo Transacción
             If Blnexiste = True Then  ' entonces si existe se cancela la actualizacion
               If UCase(Trim(lstr_tabladestino)) = "AR_CCDOC" Then
                  rs_destino.Update
               Else
                  rs_destino.CancelUpdate
               End If
             Else
                rs_destino.Update
             End If
        Else
             
             rs_destino.Update
             
        End If
                                                
        Blnexiste = False
             
          'rs_destino.CancelUpdate
            
        End If
        
        'rs_fuente.MoveLast
        
AVANZA:
        rs_fuente.MoveNext
                
        nregistros = nregistros + 1
        'Debug.Print nregistros
        pgb_avance.Value = Round((100 / rs_fuente.RecordCount) * nregistros, 0)
        txt_avance.Text = CStr(nregistros) & " DE " & CStr(rs_fuente.RecordCount)
        Me.Refresh
        
    Loop
    lst_tablas.AddItem lstr_tabladestino + Str(nregistros) + " Registros Procesados " & nuevos & " Nuevos " & actualizados & " Actualizados"
    mobj_recepcion.FLAGRECEPCION mstr_site, idtabla, Mid(str_bd, 5, 8), GCUSERID, str_bd
    
    If Not rs_destino.EOF Then
       rs_destino.Update
    End If
    'con.CommitTrans confirma transaccion
Else
    lst_tablas.AddItem "!! " + lstr_tabladestino + " Sin Registros"
End If


rs_destino.Close
Set rs_destino = Nothing
con.Close


Set MRsImport = Nothing
Set MCmdImport = Nothing
MConImport.Close
Set MConImport = New ADODB.Connection
Set rs_fuente = Nothing
Set rs_pk = Nothing

Set con = Nothing
Set rs_meta = Nothing

Exit Sub

trataerror:
lst_tablas.AddItem "!!!!! " + lstr_tabladestino + " Errores en la recepcion !!!!"
Set rs_destino = Nothing
'con.RollbackTrans
con.Close

Set MRsImport = Nothing
Set MCmdImport = Nothing
MConImport.Close
Set MConImport = New ADODB.Connection
Set rs_fuente = Nothing
Set rs_pk = Nothing
Set rs_meta = Nothing

End Sub
Function CADENAPK(ByRef rsfuente As DAO.Recordset, ByRef RSDESTINO As ADODB.Recordset, _
                    ByRef RSPK As ADODB.Recordset) As String
                    
Dim CADENA As String
Dim NCAMPOS As String
Dim CAMPO As String
Dim i As Integer
Dim li_tipocampo As Integer
Dim valor As Variant

NCAMPOS = RSPK.RecordCount
RSPK.MoveFirst
Do While Not RSPK.EOF
    
    CAMPO = RSPK!COLUMN_NAME
    valor = rsfuente.Fields(CAMPO).Value
    
    li_tipocampo = RSDESTINO.Fields(CAMPO).Type
    Select Case li_tipocampo
        Case 129, 200  'char
            CADENA = CADENA & CAMPO & "='" & valor & "'"
        Case 11 'boolean
            CADENA = CADENA & CAMPO & "=" & valor
        Case 135 'smalldatetime
            CADENA = CADENA & CAMPO & "='" & valor & "'"
        Case 131    'numeric
            CADENA = CADENA & CAMPO & "=" & valor
        Case 5  'float
            CADENA = CADENA & CAMPO & "=" & valor
        Case 3, 17, 2 'int
            CADENA = CADENA & CAMPO & "=" & valor
        Case Else
            MsgBox CAMPO & "tipo:" & Str(li_tipocampo) & Chr(13), vbCritical, "Tipo Campo No Reconocido"
    End Select
    RSPK.MoveNext
    If Not RSPK.EOF Then
        CADENA = CADENA & " and "
    End If
Loop
CADENAPK = CADENA
End Function
Sub salir_formulario()
    Call Cmd_salir_Click
End Sub

Private Sub cmd_reporte_Click()
'Dim lint_ntablas As Integer
'Dim I As Integer
'If lst_tablas.ListCount = 0 Then
'    Exit Sub
'End If
'Printer.Print Txt_archivo.Text
'Printer.Print Txt_archivo.Text
'Printer.Print Txt_archivo.Text
'Printer.Print ""
'For I = 1 To lst_tablas.ListCount
'    Printer.Print lst_tablas.List(I)
'Next
'
'Printer.EndDoc

End Sub

Private Sub Cmd_salir_Click()
    Unload Me
End Sub

Private Sub CMD_SELEC_FILE_Click()

FrmDir.Dir1.Path = mstr_ruta
FrmDir.Drive1.Drive = mstr_ruta
FrmDir.Show vbModal
txtdirecotio.Text = LstrDirectorio
    
    
'    CD_OPEN.CancelError = True
'    On Error GoTo TrataError
'    'CD_OPEN.Filter = "Envios de Estacion a Central (ec*.mdb)|*.mdb|Envios de Central a Estacion (ce*.mdb)|*.mdb"
'
'    CD_OPEN.Filter = "Recepción de Archivos |*.MDB|"
'
'
'    CD_OPEN.InitDir = mstr_ruta
'    CD_OPEN.FilterIndex = 0
'    CD_OPEN.ShowOpen
'
'    ' Hay que descomprimir el Archivo
'
'    'Dim cadzip As String
'    'cadzip = "pkunzip " + CD_OPEN.FileName + " " + CD_OPEN.FileTitle
'    'Shell (cadzip)
'
'    ' Fin de descomprimir el Archivo
'
'
'    Txt_archivo.Text = CD_OPEN.FileTitle
'
'    str_archivo = CD_OPEN.FileTitle
'
'
'    mstr_site = Mid(CD_OPEN.FileTitle, 1, 2)
'    mstr_nombresite = mobj_sites.ObtenerDescripcionAlmacen(mstr_site)
'    TXT_SITE.Text = mstr_site + " " + mstr_nombresite
'
            
    Exit Sub
    
trataerror:
    ' El usuario ha hecho clic en el botón Cancelar
    MsgBox "Debe Escoger un Archivo", vbExclamation, "Datos Incompletos"
    Exit Sub
End Sub

Private Sub Form_Activate()
    Call gactualizaopcion(pbderecho_agregar, pbderecho_editar, pbderecho_borrar, pbderecho_imprimir)
    Call gactualiza_barra(Me)
    
    If GintCentralEstacion = 1 Then
       Opt_centralestacion.Value = False
       Opt_estacioncentral.Value = True
    Else
       If GintCentralEstacion = 0 Then
          Opt_centralestacion.Value = True
          Opt_estacioncentral.Value = False
        End If
    End If

    'lineas nuevas
    If pbderecho_consultar = False Then
        Unload Me
    End If
End Sub

Private Sub Form_Load()
   Call gseguridad(Me)
   
    If pbderecho_consultar Then
        Set mobj_recepcion = New lib_trasmision.Cls_recepcion
        Set mobj_gen = New lib_trasmision.Cls_general
        Set mobj_sites = New DB_INV_MANTENIMIENTOS.C_ALMACEN
        Set rs_sites = New ADODB.Recordset
        Set rs_sites = mobj_sites.ListarAlmacenesAyuda
        mstr_ruta = mobj_recepcion.rutarecepcion
        'lineas nuevas
    Else
        'Unload Me
        MsgBox ("No tiene Derechos de Consultar en este formulario"), vbCritical + vbDefaultButton1, "Mensaje"
    End If
    Me.Height = 6270
    Me.Width = 9615
    
End Sub


