VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{C4DED68B-C40F-11D6-AD1A-000795CA0957}#50.0#0"; "pry_list.ocx"
Begin VB.Form F_envio 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Envio de Informacion (95.140.00)"
   ClientHeight    =   5610
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9450
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   5610
   ScaleWidth      =   9450
   Begin TabDlg.SSTab SSTab1 
      Height          =   5595
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   9435
      _ExtentX        =   16642
      _ExtentY        =   9869
      _Version        =   393216
      TabHeight       =   520
      TabCaption(0)   =   "Envio de Informacion"
      TabPicture(0)   =   "9514000.frx":0000
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "Label1"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).Control(1)=   "Label2"
      Tab(0).Control(1).Enabled=   0   'False
      Tab(0).Control(2)=   "Label3"
      Tab(0).Control(2).Enabled=   0   'False
      Tab(0).Control(3)=   "Label4"
      Tab(0).Control(3).Enabled=   0   'False
      Tab(0).Control(4)=   "cmd_aceptar"
      Tab(0).Control(4).Enabled=   0   'False
      Tab(0).Control(5)=   "Cmd_salir"
      Tab(0).Control(5).Enabled=   0   'False
      Tab(0).Control(6)=   "lst_tablas"
      Tab(0).Control(6).Enabled=   0   'False
      Tab(0).Control(7)=   "DT_fecha"
      Tab(0).Control(7).Enabled=   0   'False
      Tab(0).Control(8)=   "Opt_estacioncentral"
      Tab(0).Control(8).Enabled=   0   'False
      Tab(0).Control(9)=   "Opt_centralestacion"
      Tab(0).Control(9).Enabled=   0   'False
      Tab(0).Control(10)=   "Txt_archivo"
      Tab(0).Control(10).Enabled=   0   'False
      Tab(0).Control(11)=   "Txt_tabla"
      Tab(0).Control(11).Enabled=   0   'False
      Tab(0).Control(12)=   "pgb_avance"
      Tab(0).Control(12).Enabled=   0   'False
      Tab(0).Control(13)=   "TXT_SITE"
      Tab(0).Control(13).Enabled=   0   'False
      Tab(0).Control(14)=   "Lst_sites"
      Tab(0).Control(14).Enabled=   0   'False
      Tab(0).Control(15)=   "txt_avance"
      Tab(0).Control(15).Enabled=   0   'False
      Tab(0).Control(16)=   "Command1"
      Tab(0).Control(16).Enabled=   0   'False
      Tab(0).Control(17)=   "Command3"
      Tab(0).Control(17).Enabled=   0   'False
      Tab(0).ControlCount=   18
      TabCaption(1)   =   "Seleccionar Tablas Envio"
      TabPicture(1)   =   "9514000.frx":001C
      Tab(1).ControlEnabled=   0   'False
      Tab(1).Control(0)=   "SSTab2"
      Tab(1).ControlCount=   1
      TabCaption(2)   =   "Sites "
      TabPicture(2)   =   "9514000.frx":0038
      Tab(2).ControlEnabled=   0   'False
      Tab(2).Control(0)=   "ctrl_sites"
      Tab(2).ControlCount=   1
      Begin VB.CommandButton Command3 
         Caption         =   "Command3"
         Height          =   615
         Left            =   6960
         TabIndex        =   35
         Top             =   4680
         Visible         =   0   'False
         Width           =   855
      End
      Begin VB.CommandButton Command1 
         Caption         =   "Command1"
         Height          =   615
         Left            =   6120
         TabIndex        =   34
         Top             =   4680
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.TextBox txt_avance 
         Enabled         =   0   'False
         Height          =   315
         Left            =   7260
         TabIndex        =   33
         Top             =   1860
         Visible         =   0   'False
         Width           =   1995
      End
      Begin pry_list.ctrl_listarray ctrl_sites 
         Height          =   4995
         Left            =   -74940
         TabIndex        =   32
         Top             =   420
         Width           =   9255
         _ExtentX        =   16325
         _ExtentY        =   8811
      End
      Begin VB.ListBox Lst_sites 
         Height          =   2205
         Left            =   4800
         TabIndex        =   31
         Top             =   2220
         Width           =   4455
      End
      Begin VB.TextBox TXT_SITE 
         Height          =   375
         Left            =   4260
         Locked          =   -1  'True
         TabIndex        =   29
         Top             =   1440
         Width           =   4875
      End
      Begin MSComctlLib.ProgressBar pgb_avance 
         Height          =   315
         Left            =   180
         TabIndex        =   28
         Top             =   1860
         Visible         =   0   'False
         Width           =   7035
         _ExtentX        =   12409
         _ExtentY        =   556
         _Version        =   393216
         Appearance      =   1
      End
      Begin VB.TextBox Txt_tabla 
         Height          =   375
         Left            =   4260
         Locked          =   -1  'True
         TabIndex        =   26
         Top             =   960
         Width           =   4875
      End
      Begin VB.TextBox Txt_archivo 
         Height          =   375
         Left            =   4260
         Locked          =   -1  'True
         TabIndex        =   24
         Top             =   480
         Width           =   4875
      End
      Begin TabDlg.SSTab SSTab2 
         Height          =   4935
         Left            =   -74820
         TabIndex        =   8
         Top             =   480
         Width           =   9015
         _ExtentX        =   15901
         _ExtentY        =   8705
         _Version        =   393216
         Tabs            =   5
         Tab             =   3
         TabsPerRow      =   5
         TabHeight       =   520
         TabCaption(0)   =   "Seguridad"
         TabPicture(0)   =   "9514000.frx":0054
         Tab(0).ControlEnabled=   0   'False
         Tab(0).Control(0)=   "Lst_seguridad"
         Tab(0).Control(1)=   "Command2"
         Tab(0).Control(2)=   "Cmd_sseguridad"
         Tab(0).ControlCount=   3
         TabCaption(1)   =   "Maestros"
         TabPicture(1)   =   "9514000.frx":0070
         Tab(1).ControlEnabled=   0   'False
         Tab(1).Control(0)=   "Lst_maestros"
         Tab(1).Control(1)=   "Command4"
         Tab(1).Control(2)=   "Command5"
         Tab(1).ControlCount=   3
         TabCaption(2)   =   "Inventarios"
         TabPicture(2)   =   "9514000.frx":008C
         Tab(2).ControlEnabled=   0   'False
         Tab(2).Control(0)=   "Lst_inventarios"
         Tab(2).Control(1)=   "Command6"
         Tab(2).Control(2)=   "Command7"
         Tab(2).ControlCount=   3
         TabCaption(3)   =   "Ventas"
         TabPicture(3)   =   "9514000.frx":00A8
         Tab(3).ControlEnabled=   -1  'True
         Tab(3).Control(0)=   "LST_VENTAS"
         Tab(3).Control(0).Enabled=   0   'False
         Tab(3).Control(1)=   "Command8"
         Tab(3).Control(1).Enabled=   0   'False
         Tab(3).Control(2)=   "Command9"
         Tab(3).Control(2).Enabled=   0   'False
         Tab(3).ControlCount=   3
         TabCaption(4)   =   "Cuenta Cte."
         TabPicture(4)   =   "9514000.frx":00C4
         Tab(4).ControlEnabled=   0   'False
         Tab(4).Control(0)=   "LST_CTACTE"
         Tab(4).Control(1)=   "Command10"
         Tab(4).Control(2)=   "Command11"
         Tab(4).ControlCount=   3
         Begin VB.CommandButton Command11 
            Caption         =   "Deseleccionar "
            Height          =   735
            Left            =   -67800
            Picture         =   "9514000.frx":00E0
            Style           =   1  'Graphical
            TabIndex        =   23
            Top             =   420
            Width           =   1575
         End
         Begin VB.CommandButton Command10 
            Caption         =   "Seleccionar Todos"
            Height          =   735
            Left            =   -74820
            Picture         =   "9514000.frx":03EA
            Style           =   1  'Graphical
            TabIndex        =   22
            Top             =   480
            Width           =   1575
         End
         Begin VB.CommandButton Command9 
            Caption         =   "Deseleccionar "
            Height          =   735
            Left            =   7200
            Picture         =   "9514000.frx":06F4
            Style           =   1  'Graphical
            TabIndex        =   21
            Top             =   420
            Width           =   1575
         End
         Begin VB.CommandButton Command8 
            Caption         =   "Seleccionar Todos"
            Height          =   735
            Left            =   180
            Picture         =   "9514000.frx":09FE
            Style           =   1  'Graphical
            TabIndex        =   20
            Top             =   480
            Width           =   1575
         End
         Begin VB.CommandButton Command7 
            Caption         =   "Deseleccionar "
            Height          =   735
            Left            =   -67800
            Picture         =   "9514000.frx":0D08
            Style           =   1  'Graphical
            TabIndex        =   19
            Top             =   420
            Width           =   1575
         End
         Begin VB.CommandButton Command6 
            Caption         =   "Seleccionar Todos"
            Height          =   735
            Left            =   -74820
            Picture         =   "9514000.frx":1012
            Style           =   1  'Graphical
            TabIndex        =   18
            Top             =   480
            Width           =   1575
         End
         Begin VB.CommandButton Command5 
            Caption         =   "Deseleccionar "
            Height          =   735
            Left            =   -67800
            Picture         =   "9514000.frx":131C
            Style           =   1  'Graphical
            TabIndex        =   17
            Top             =   420
            Width           =   1575
         End
         Begin VB.CommandButton Command4 
            Caption         =   "Seleccionar Todos"
            Height          =   735
            Left            =   -74820
            Picture         =   "9514000.frx":1626
            Style           =   1  'Graphical
            TabIndex        =   16
            Top             =   480
            Width           =   1575
         End
         Begin VB.CommandButton Cmd_sseguridad 
            Caption         =   "Seleccionar Todos"
            Height          =   735
            Left            =   -74820
            Picture         =   "9514000.frx":1930
            Style           =   1  'Graphical
            TabIndex        =   15
            Top             =   480
            Width           =   1575
         End
         Begin VB.CommandButton Command2 
            Caption         =   "Deseleccionar "
            Height          =   735
            Left            =   -67800
            Picture         =   "9514000.frx":1C3A
            Style           =   1  'Graphical
            TabIndex        =   14
            Top             =   420
            Width           =   1575
         End
         Begin VB.ListBox LST_CTACTE 
            Height          =   3435
            Left            =   -74820
            Style           =   1  'Checkbox
            TabIndex        =   13
            Top             =   1260
            Width           =   8655
         End
         Begin VB.ListBox LST_VENTAS 
            Height          =   3435
            Left            =   180
            Style           =   1  'Checkbox
            TabIndex        =   12
            Top             =   1260
            Width           =   8655
         End
         Begin VB.ListBox Lst_inventarios 
            Height          =   3435
            Left            =   -74820
            Style           =   1  'Checkbox
            TabIndex        =   11
            Top             =   1260
            Width           =   8655
         End
         Begin VB.ListBox Lst_maestros 
            Height          =   3435
            Left            =   -74820
            Style           =   1  'Checkbox
            TabIndex        =   10
            Top             =   1260
            Width           =   8655
         End
         Begin VB.ListBox Lst_seguridad 
            Height          =   3435
            Left            =   -74820
            Style           =   1  'Checkbox
            TabIndex        =   9
            Top             =   1260
            Width           =   8655
         End
      End
      Begin VB.OptionButton Opt_centralestacion 
         Caption         =   "Central a Estacion"
         Enabled         =   0   'False
         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        =   7
         Top             =   840
         Width           =   2595
      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 MSComCtl2.DTPicker DT_fecha 
         Height          =   375
         Left            =   1500
         TabIndex        =   4
         Top             =   1380
         Width           =   1335
         _ExtentX        =   2355
         _ExtentY        =   661
         _Version        =   393216
         CustomFormat    =   "dd/MM/yyyy"
         Format          =   16908291
         CurrentDate     =   37649
      End
      Begin VB.ListBox lst_tablas 
         Height          =   3180
         Left            =   120
         TabIndex        =   3
         Top             =   2220
         Width           =   4635
      End
      Begin VB.CommandButton Cmd_salir 
         Cancel          =   -1  'True
         Caption         =   "Salir"
         Height          =   795
         Left            =   8160
         Picture         =   "9514000.frx":1F44
         Style           =   1  'Graphical
         TabIndex        =   2
         Top             =   4680
         Width           =   1095
      End
      Begin VB.CommandButton cmd_aceptar 
         Caption         =   "Exportar"
         Height          =   795
         Left            =   4920
         Picture         =   "9514000.frx":224E
         Style           =   1  'Graphical
         TabIndex        =   1
         Top             =   4680
         Width           =   1095
      End
      Begin VB.Label Label4 
         Caption         =   "Site en Proceso:"
         Height          =   255
         Left            =   3060
         TabIndex        =   30
         Top             =   1500
         Width           =   1215
      End
      Begin VB.Label Label3 
         Caption         =   "Tabla en Proceso:"
         Height          =   255
         Left            =   2940
         TabIndex        =   27
         Top             =   1020
         Width           =   1395
      End
      Begin VB.Label Label2 
         Caption         =   "Archivo Destino:"
         Height          =   255
         Left            =   3060
         TabIndex        =   25
         Top             =   540
         Width           =   1215
      End
      Begin VB.Label Label1 
         Caption         =   "Fecha Proceso:"
         Height          =   315
         Left            =   360
         TabIndex        =   5
         Top             =   1440
         Width           =   1215
      End
   End
End
Attribute VB_Name = "F_envio"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'*****************************************************************
Dim MConImport_ENV  As ADODB.Connection
Dim MRsImport_ENV   As ADODB.Recordset
Dim MCmdImport_ENV  As ADODB.Command
'*****************************************************************

Dim mobj_envios As lib_trasmision.Cls_envios
Dim mobj_gen As lib_trasmision.Cls_general
Dim str_archivo As String
Dim RSDESTINO As ADODB.Recordset
Dim rs_sites As ADODB.Recordset
Dim mstr_siteorigen As String
Dim mstr_nombresiteorigen As String
Dim mstr_ruta As String
Dim mobj_sites As DB_INV_MANTENIMIENTOS.C_ALMACEN
Dim GCUSERID As String
Dim MStrNombreArchivo 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 crear_bd(ByVal str_nombredb As String)
'crear base de datos

   Dim wrkPredeterminado As Workspace
   Dim dbsNueva As Database
   Dim prpBucle As Property
   Dim str_bd As String
   Dim fso
   
   str_bd = str_nombredb

   ' Obtiene el Workspace predeterminado.
   Set wrkPredeterminado = DBEngine.Workspaces(0)

   ' Asegúrese de que no existe un archivo con el
   ' nombre de la base de datos nueva.
   If Dir(str_bd) <> "" Then
        'Kill str_bd
    End If
   ' Crea a una base de datos nueva encriptada con la
   ' secuencia de intercalación especificada.
   
   ' Hay que borrar la Tabla sh_Shippings
         
        Dim DB_UTMANT As DB_UT_MANTENIMIENTOS.C_PROCESOS
        
        Set DB_UTMANT = New DB_UT_MANTENIMIENTOS.C_PROCESOS
        
        DB_UTMANT.Auxiliar1 "DELETE FROM SH_SHIPPINGS"
      
        Set DB_UTMANT = Nothing
      
   ' *************************************
     
   If Dir(str_bd) <> "" Then
            
      Set fso = CreateObject("Scripting.FileSystemObject")
      fso.deletefile str_bd
                  
      Do While Dir(str_bd) <> ""
      Loop
            
      Set dbsNueva = wrkPredeterminado.CreateDatabase(str_bd, dbLangGeneral)
            
   Else
'        'Validar la existencia de la carpeta destino
'        If Len(Trim$(Dir$(str_bd, vbDirectory))) < 1 Then
'
'        End If
   
      Set dbsNueva = wrkPredeterminado.CreateDatabase(str_bd, dbLangGeneral)
   End If
   

   dbsNueva.Close

End Sub

Private Sub CMD_ACEPTAR_Click()
Dim sites()
Dim lint_nsites As Integer
Dim i As Integer
Dim g As Integer
Dim h As Integer
Dim Lstrnombresincompactar As String
Dim LintPosicionEnc As Integer
Dim LstrNombreCompactado As String
Dim LstrArchivosinCompac As String
Dim LstrArchivoCompac As String
            
Dim fso, Archivo
Dim StrCadZip As String

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

If GintCentralEstacion <> 1 Then

    Set MConImport_ENV = New ADODB.Connection
    Set MRsImport_ENV = New ADODB.Recordset
    Set MCmdImport_ENV = New ADODB.Command
    MConImport_ENV.ConnectionString = "DSN=SIES;UID=sa;PWD="
    MConImport_ENV.Open

    MCmdImport_ENV.ActiveConnection = MConImport_ENV
    MCmdImport_ENV.CommandText = "Valida_FGKEY '" & Format(DT_fecha.Value, "yyyymmdd") & "'"
    MCmdImport_ENV.Execute

    Set MCmdImport_ENV = Nothing
    
End If
'************************************************************


lst_tablas.Clear
pgb_avance.Visible = True
txt_avance.Visible = True

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

'Hay que Eliminar el Archivo Zip si es que existe
    
'If Dir(mstr_ruta & Trim(GstrNombreZip) + Trim(mstr_siteorigen) & ".zip") <> "" Then
If Dir(mstr_ruta & Trim(GstrNombreZip) + Trim(mstr_siteorigen) & "_" & Format(DT_fecha.Value, "yyyyMMdd") & ".zip") <> "" Then

   Set fso = CreateObject("Scripting.FileSystemObject")
   'fso.deletefile mstr_ruta & Trim(GstrNombreZip) + Trim(mstr_siteorigen) & ".zip"
   fso.deletefile mstr_ruta & Trim(GstrNombreZip) + Trim(mstr_siteorigen) & "_" & Format(DT_fecha.Value, "yyyyMMdd") & ".zip"
End If

'Fin de Eliminar del Archivo Zip si es qu existe

Call genera_nombrearchivo(mstr_siteorigen)
If Opt_centralestacion.Value Then
    If ctrl_sites.nseleccionados = 0 Then
        MsgBox "Debe Seleccionar Como Minimo Un Site Destino", vbExclamation, "Datos Insuficientes"
        Exit Sub
    End If
    If ctrl_sites.ndisponibles > 0 Then
        If MsgBox("No realizar un envio a todas las estaciones puede ocasionar conflictos" + Chr(13) + "Es recomendable que solo envie maestras especificas por site" + Chr(13) + Chr(13) + "Desea Continuar", vbYesNo, "Atencion") = vbNo Then
            Exit Sub
        End If
    End If
    
    ' Cuando se envíe op_cust_limit se tiene que enviar AR_CCDOCDET
        
   Dim j As Integer
   Dim L As Integer
        
    For j = 0 To LST_VENTAS.ListCount - 1
       If LST_VENTAS.List(j) = "055-OP_CUST_LIMIT" Then
          If LST_VENTAS.Selected(j) = True Then
             For L = 0 To LST_CTACTE.ListCount - 1
                 If LST_CTACTE.List(L) = "002-AR_CCDOCDET" Then
                    LST_CTACTE.Selected(L) = True
                 End If
             Next
          End If
       End If
    Next
     
    ' Fin de Verificación
        
    sites = ctrl_sites.llenar_matrizseleccionados
    lint_nsites = UBound(sites)
    
    
    If Opt_centralestacion.Value = True Then
        Dim Csite As Integer
        For Csite = 1 To lint_nsites
            If Dir(mstr_ruta & Trim(GstrNombreZip) + Trim(sites(Csite, 1)) & ".zip") <> "" Then
               Set fso = CreateObject("Scripting.FileSystemObject")
               fso.deletefile mstr_ruta & Trim(GstrNombreZip) + Trim(sites(Csite, 1)) & ".zip"
             End If
        Next
    End If
    

    'REALIZAR UN BUCLE PARA GENERAR PARA TODOS LOS SITES
    
    'mobj_envios.Transferir_Solomon
    
    ' Parte que se anexa para Aplicar Pagos
    
      Dim cn As ADODB.Connection
      Dim cmd As ADODB.Command
    
      Set cn = New ADODB.Connection
      Set cmd = New ADODB.Command
    
      cn.ConnectionString = "DSN=SIES;UID=sa;PWD="
      cn.CursorLocation = adUseClient
      cn.Open
      
      cmd.ActiveConnection = cn
      cmd.CommandType = adCmdStoredProc
      cmd.CommandTimeout = 0
      cmd.CommandText = "AR_APLICARPAGOS_TRANFERPROC"
      
      Screen.MousePointer = 11
       cmd.Execute
      Screen.MousePointer = 0
      
      Set cn = Nothing
      Set cmd = Nothing
      
    '******************************************************
    

    lst_tablas.AddItem ""
    lst_tablas.AddItem "**********************************************************************************"
    lst_tablas.AddItem "******     TRANSFERENCIA [APLIACIONES DE PAGO]    ******************************************************************************"
    lst_tablas.AddItem "**********************************************************************************"
    lst_tablas.AddItem ""
        
    Dim LS_SITE As String
    For i = 1 To lint_nsites
        
        LS_SITE = sites(i, 1)
        lst_tablas.AddItem ""
        lst_tablas.AddItem "**********************************************************************************"
        lst_tablas.AddItem "*************    " & " PROCESANDO ALMACEN " & LS_SITE & "  *********************************************************************"
        lst_tablas.AddItem "**********************************************************************************"
        lst_tablas.AddItem ""
       
        'lst_tablas.Clear
        
        mstr_siteorigen = sites(i, 1)
        TXT_SITE.Text = LS_SITE + " " + sites(i, 2)
        Call genera_nombrearchivo(LS_SITE)
        Call crear_bd(str_archivo)
        Call envios(Lst_seguridad)
        Call envios(Lst_maestros)
        Call envios(Lst_inventarios)
        Call envios(LST_VENTAS)
        
        ' Antes de Enviar las Tablas Hay que Procesar las Aplicaciones de Pago
                        
        ' Antes de Enviar las Tablas Hay que Procesar las Aplicaciones de Pago
        
        Call envios(LST_CTACTE)
    
        Lst_sites.AddItem (Dir(str_archivo) + "-" + LS_SITE + " " + sites(i, 2) + " ")
        Lst_sites.ListIndex = Lst_sites.ListCount - 1
        
'Rutina para la Compactacion de la Base de Datos Access
                
                
            If Mid(Trim(str_archivo), Len(str_archivo) - 2, 3) = "MDB" Then
               LstrNombreCompactado = Mid(Trim(str_archivo), 1, Len(str_archivo) - 4) + "-CP.MDB"
            Else
               LstrNombreCompactado = Trim(str_archivo) + "-CP.MDB"
            End If
                       
            lst_tablas.AddItem "Compactando Base de Datos"
                                                                        
            DBEngine.CompactDatabase str_archivo, LstrNombreCompactado
            
            
            lst_tablas.AddItem "Buscando Archivo a Compactar"
            Do While Trim(Dir(str_archivo)) = ""
               lst_tablas.AddItem "Buscando Archivo a Compactar"
            Loop
            lst_tablas.AddItem "Archivo a Compactar Encontrado"
    
                                                       
            ' Hay que Borrar el Archivo Original
                                
            Set fso = CreateObject("Scripting.FileSystemObject")
            fso.deletefile str_archivo
                                
            ' Hay que Renombrar el Archivo Compactado con un nombre mas pequeño
                                                                              
            lst_tablas.AddItem "Buscando Archivo Compactado para renombrar"
               Do While Trim(Dir(LstrNombreCompactado)) = ""
                  lst_tablas.AddItem "Buscando Archivo Compactado para renombrar"
               Loop
            lst_tablas.AddItem "Archivo Compactado Encontrado "
                                                                              
                                                                              
            Set fso = CreateObject("Scripting.FileSystemObject")
            fso.copyfile LstrNombreCompactado, mstr_ruta + Trim(mstr_siteorigen) + Format(DT_fecha.Value, "ddmmyy") + ".mdb"
                                         
            ' Hay que Mover el Archivo Compactado a una Carpeta Historica
                                    
                For g = Len(Trim(LstrNombreCompactado)) To 1 Step -1
                   If Mid(Trim(LstrNombreCompactado), g, 1) = "\" Then
                      LintPosicionEnc = g + 1
                      Exit For
                   End If
                Next
        
                LstrArchivoCompac = Mid(LstrNombreCompactado, LintPosicionEnc)
            
            If Right(GstrRutaHistoricaTrans, 1) <> "\" Then
               GstrRutaHistoricaTrans = GstrRutaHistoricaTrans + "\"
            End If
            
            ' Hay que Obtener el Nombre del Archivo sin Compactar
                                    
                For h = Len(Trim(str_archivo)) To 1 Step -1
                   If Mid(Trim(str_archivo), h, 1) = "\" Then
                      LintPosicionEnc = h + 1
                      Exit For
                   End If
                Next
            
            Lstrnombresincompactar = Mid(str_archivo, LintPosicionEnc)
            
            Set fso = CreateObject("Scripting.FileSystemObject")
            fso.copyfile LstrNombreCompactado, GstrRutaHistoricaTrans + Lstrnombresincompactar
                                              
                                              
            ' Hay que Eliminar el Archivo Compactado
            
            Do While Trim(Dir(LstrNombreCompactado)) = ""
               lst_tablas.AddItem "Buscando Base de Datos Compactada /Eliminar "
            Loop
            
                                                          
            Set fso = CreateObject("Scripting.FileSystemObject")
            fso.deletefile LstrNombreCompactado
                                              
                                                                                                                                                    
            ' Hay que Zipear el Archivo
            
            StrCadZip = "C:\pkzip -ex " & mstr_ruta & Trim(GstrNombreZip) + Trim(mstr_siteorigen) & ".zip " & mstr_ruta + Trim(mstr_siteorigen) + Format(DT_fecha.Value, "ddmmyy") + ".mdb"
            Shell (StrCadZip)
    
            'Set fso = CreateObject("Scripting.FileSystemObject")
            'fso.deletefile mstr_ruta + Trim(mstr_siteorigen) + Format(DT_fecha.Value, "ddmmyy") + ".mdb"
       
    'Fin de Rutina de Compactacion
                
    Next
    
    Call FLAGS(Lst_seguridad)
    Call FLAGS(Lst_maestros)
    Call FLAGS(Lst_inventarios)
    Call FLAGS(LST_VENTAS)
    Call FLAGS(LST_CTACTE)
    
Else

    mstr_siteorigen = mobj_sites.Almacenoriginal
    TXT_SITE.Text = mstr_siteorigen + " " + mstr_nombresiteorigen
    Call crear_bd(str_archivo)
     
    Call envios(Lst_seguridad)

    Call envios(Lst_maestros)
    Call envios(Lst_inventarios)
    Call envios(LST_VENTAS)
    Call envios(LST_CTACTE)
    
    Call FLAGS(Lst_seguridad)
    Call FLAGS(Lst_maestros)
    Call FLAGS(Lst_inventarios)
    Call FLAGS(LST_VENTAS)
    Call FLAGS(LST_CTACTE)
    
    
    
         
    Do While Trim(Dir(str_archivo)) = ""
       lst_tablas.AddItem "Buscando Archivo de Envío....."
    Loop
            
    Lst_sites.AddItem (Dir(str_archivo) + "-" + mstr_siteorigen + " " + mstr_nombresiteorigen)
    
    
    
    'Rutina para la Compactacion de la Base de Datos Access
                
                
            If Mid(Trim(str_archivo), Len(str_archivo) - 2, 3) = "MDB" Then
               LstrNombreCompactado = Mid(Trim(str_archivo), 1, Len(str_archivo) - 4) + "-CP.MDB"
            Else
               LstrNombreCompactado = Trim(str_archivo) + "-CP.MDB"
            End If
                       
            lst_tablas.AddItem "Compactando Base de Datos"
                                                                                                                                                     
                                         
            '*******************************************************
            ' Parte Nueva*******************************************
            '*******************************************************
              
              lst_tablas.AddItem "Buscando Archivo a Compactar"
              
              Do While Trim(Dir(str_archivo)) = ""
                 lst_tablas.AddItem "Buscando Archivo a Compactar"
              Loop
              
              lst_tablas.AddItem "Archivo a Compactar Encontrado"
              
            '********************************************************
            ' Parte Nueva********************************************
            '********************************************************
                                                            
             If Dir(Trim(LstrNombreCompactado)) <> "" Then
                Set fso = CreateObject("Scripting.FileSystemObject")
                fso.deletefile LstrNombreCompactado
             End If
                                
             Do While Dir(Trim(LstrNombreCompactado)) <> ""
             Loop
                                                                                                                                                                 
             DBEngine.CompactDatabase str_archivo, LstrNombreCompactado
                                
                                    
             ' MsgBox "Se ha Compactado al Base de Datos"
             ' Hay que Borrar el Archivo Original
                                
             Do While Trim(Dir(str_archivo)) = ""
                lst_tablas.AddItem "Buscando Archivo Compactado"
             Loop
                                                                                                                               
    
                                                                                                                               
             Set fso = CreateObject("Scripting.FileSystemObject")
             fso.deletefile str_archivo
                                
                                
    
             
            ' Hay que Renombrar el Archivo Compactado con un nombre mas pequeño
                                                                                                                                                                  
            '********************************************************
            ' Parte Nueva *******************************************
            '********************************************************
            
             lst_tablas.AddItem "Buscando Archivo Compactado para renombrar"
               Do While Trim(Dir(LstrNombreCompactado)) = ""
                  lst_tablas.AddItem "Buscando Archivo Compactado para renombrar"
               Loop
             lst_tablas.AddItem "Archivo Compactado Encontrado "
           
            '*******************************************************
            '*******************************************************
            '*******************************************************
                                                                              
    
                                                                              
            'MsgBox "Se está renombrando el nombre compactado "
                                                                              
            Set fso = CreateObject("Scripting.FileSystemObject")
            'fso.copyfile LstrNombreCompactado, mstr_ruta + Trim(mstr_siteorigen) + Format(DT_fecha.Value, "ddmmyy") + ".mdb"
            fso.copyfile LstrNombreCompactado, mstr_ruta + Trim(mstr_siteorigen) + "_" + Format(DT_fecha.Value, "yyyyMMdd") + ".mdb"
                                         
    
                                         
            ' Hay que Mover el Archivo Compactado a una Carpeta Historica
                                   
                For i = Len(Trim(LstrNombreCompactado)) To 1 Step -1
                   If Mid(Trim(LstrNombreCompactado), i, 1) = "\" Then
                      LintPosicionEnc = i + 1
                      Exit For
                   End If
                Next
        
                LstrArchivoCompac = Mid(LstrNombreCompactado, LintPosicionEnc)
            
    
            
            If Right(GstrRutaHistoricaTrans, 1) <> "\" Then
               GstrRutaHistoricaTrans = GstrRutaHistoricaTrans + "\"
            End If
            
            ' Hay que Obtener el Nombre del Archivo sin Compactar
                                    
                For i = Len(Trim(str_archivo)) To 1 Step -1
                   If Mid(Trim(str_archivo), i, 1) = "\" Then
                      LintPosicionEnc = i + 1
                      Exit For
                   End If
                Next
            
            Lstrnombresincompactar = Mid(str_archivo, LintPosicionEnc)
                        
            'lst_tablas.AddItem "Buscando Base de Datos Compactada /Histórico "
            Do While Trim(Dir(LstrNombreCompactado)) = ""
               lst_tablas.AddItem "Buscando Base de Datos Compactada /Histórico "
            Loop
                                                                        
            'MsgBox LstrNombreCompactado
            'MsgBox GstrRutaHistoricaTrans + Lstrnombresincompactar
            
            
                                                                        
            Set fso = CreateObject("Scripting.FileSystemObject")
            
            'Si no existe la ruta, toca crearla
            'Validar la existencia de la carpeta destino
            If Len(Trim$(Dir$(GstrRutaHistoricaTrans, vbDirectory))) < 1 Then
                Call MkDir(GstrRutaHistoricaTrans)
            End If
            
              
            fso.copyfile LstrNombreCompactado, GstrRutaHistoricaTrans + Lstrnombresincompactar
                                              
            
                                              
            ' Hay que Eliminar el Archivo Compactado
                                              
            'lst_tablas.AddItem "Buscando Base de Datos Compactada /Eliminar "
            
            Do While Trim(Dir(LstrNombreCompactado)) = ""
               lst_tablas.AddItem "Buscando Base de Datos Compactada /Eliminar "
            Loop
                                              
            'MsgBox "Vamos a eliminar la base de datos " + LstrNombreCompactado
                                              
            
                                              
            Set fso = CreateObject("Scripting.FileSystemObject")
            fso.deletefile LstrNombreCompactado
                                              
            'MsgBox "Archivo eliminado  "
                                              
            'MsgBox "Buscando " + mstr_ruta + Trim(mstr_siteorigen) + Format(DT_fecha.Value, "ddmmyy") + ".mdb"
                                              
            
                                              
            'Do While Trim(Dir(mstr_ruta + Trim(mstr_siteorigen) + Format(DT_fecha.Value, "ddmmyy") + ".mdb")) = ""
            Do While Trim(Dir(mstr_ruta + Trim(mstr_siteorigen) + "_" + Format(DT_fecha.Value, "yyyyMMdd") + ".mdb")) = ""
            Loop
                                                                                                                                                                                                                                                
            ' Hay que Zipear el Archivo
                                 
            'MsgBox "Se comienza a zipear"
            
            'MsgBox mstr_ruta & Trim(GstrNombreZip) + Trim(mstr_siteorigen) & ".zip  "
            'MsgBox mstr_ruta + Trim(mstr_siteorigen) + Format(DT_fecha.Value, "ddmmyy") + ".mdb"
            
            
            
'            StrCadZip = "c:\pkzip -ex " & mstr_ruta & Trim(GstrNombreZip) + Trim(mstr_siteorigen) & ".zip  " & mstr_ruta + Trim(mstr_siteorigen) + Format(DT_fecha.Value, "ddmmyy") + ".mdb"
'            Shell (StrCadZip)
            'Para comprimir
            '-*************************************************************************************************
            Dim FileZipName As String, PathToCompress As String, DestPath As String, FullPathZip As String
            
            DestPath = "C:\"
            'nombre que le asignaremos al zip
            FileZipName = mstr_ruta & Trim(GstrNombreZip) + Trim(mstr_siteorigen) & "_" & Format(DT_fecha.Value, "yyyyMMdd") & ".zip"
'            FileZipName = Trim(GstrNombreZip) + Trim(mstr_siteorigen) & ".zip"
            
            'es nesesario utilizar el nombre corto para que funcione
'            FullPathZip = GetShortPath(DestPath) & "\" & FileZipName
            FullPathZip = FileZipName
            FullPathZip = FileZipName
            
            'Archivo o carpeta exitente que se quiere comprimir
            'PathToCompress = "C:\Archivos de programa\Windows NT\Pinball\SOUND1.WAV"
            PathToCompress = mstr_ruta & Trim(mstr_siteorigen) + "_" + Format(DT_fecha.Value, "yyyyMMdd") + ".mdb"
            
            'nombre corto
            PathToCompress = GetShortPath(PathToCompress)
            
            If WinRar <> "" Then
             Shell WinRar & " a " & FullPathZip & " " & PathToCompress ', vbHide
            Else
             Shell WinZip & " -a " & FullPathZip & " " & PathToCompress ', vbHide
            End If
            
            '-*************************************************************************************************
            'MsgBox StrCadZip
            
            'Dim Lzip As Double
            
       
            
       
            'MsgBox "se zipeo con exito"
            
    'Fin de Rutina de Compactacion
        
End If

    
MsgBox "Proceso Terminado", vbInformation, "OK"
                  
If Opt_centralestacion.Value = False Then
    Set fso = CreateObject("Scripting.FileSystemObject")
'    fso.deletefile mstr_ruta + Trim(mstr_siteorigen) + Format(DT_fecha.Value, "ddmmyy") + ".mdb"
    fso.deletefile mstr_ruta + Trim(mstr_siteorigen) + "_" + Format(DT_fecha.Value, "yyyyMMdd") + ".mdb"
Else
    Dim CsiteCp As Integer
    For CsiteCp = 1 To lint_nsites
        If Dir(mstr_ruta + Trim(sites(CsiteCp, 1)) + Format(DT_fecha.Value, "ddmmyy") + ".mdb") <> "" Then
               Set fso = CreateObject("Scripting.FileSystemObject")
               fso.deletefile mstr_ruta + Trim(sites(CsiteCp, 1)) + Format(DT_fecha.Value, "ddmmyy") + ".mdb"
             End If
        Next
End If
     
End Sub
Sub FLAGS(ByRef lst As ListBox)
Dim li_items As Integer
Dim i As Integer
Dim lstr_tabla As String
li_items = lst.ListCount

For i = 0 To li_items - 1
    If lst.Selected(i) Then
        lstr_tabla = Mid(lst.List(i), 1, 3)
        Call flag_tablas(lstr_tabla)
    End If
Next

End Sub

Sub AplicarPago()

End Sub


Sub envios(ByRef lst As ListBox)

Dim li_items As Integer
Dim i As Integer
Dim lstr_tabla As String


li_items = lst.ListCount
For i = 0 To li_items - 1
    If lst.Selected(i) Then
        lstr_tabla = Mid(lst.List(i), 1, 3)
        Call envia_tablas(lstr_tabla)
    End If
Next

End Sub

Private Sub Command1_Click()
Dim FileZipName As String, PathToCompress As String, DestPath As String, FullPathZip As String
'Ruta existente en la que se comprimira el archivo
DestPath = "C:\"
'nombre que le asignaremos al zip
FileZipName = mstr_ruta & Trim(GstrNombreZip) + Trim(mstr_siteorigen) & ".zip"

'es nesesario utilizar el nombre corto para que funcione
FullPathZip = GetShortPath(DestPath) & "\" & FileZipName
FullPathZip = FileZipName

'Archivo o carpeta exitente que se quiere comprimir
'PathToCompress = "C:\Archivos de programa\Windows NT\Pinball\SOUND1.WAV"
PathToCompress = mstr_ruta & Trim(mstr_siteorigen) + Format(DT_fecha.Value, "ddmmyy") + ".mdb"

'nombre corto
PathToCompress = GetShortPath(PathToCompress)

If WinRar <> "" Then
 Shell WinRar & " a " & FullPathZip & " " & PathToCompress ', vbHide
Else
 Shell WinZip & " -a " & FullPathZip & " " & PathToCompress ', vbHide
End If

End Sub

Private Sub Command3_Click()
Dim FullPathZip As String, FolderToDescompress As String
'Ruta existente del archivo comprimirdo
FullPathZip = "C:\ArchivoComprimido.zip"
'carpeta existente que se va a descomprimir el zip
FolderToDescompress = "C:\"
'Combercion a nombre corto
FullPathZip = GetShortPath(FullPathZip)
FolderToDescompress = GetShortPath(FolderToDescompress)
If WinRar <> "" Then
 Shell WinRar & " e " & FullPathZip & " " & FolderToDescompress ', vbHide
Else
 Shell WinZip & " -e " & FullPathZip & " " & FolderToDescompress ', vbHide
End If
End Sub


'On Error Resume Next
'Dim MiObjeto As Object, Ret As String
'Set MiObjeto = CreateObject("Wscript.Shell")
'Ret = MiObjeto.RegRead("HKEY_CLASSES_ROOT\WinRAR\shell\open\command\")
'WinRar = Left(Ret, InStrRev(Ret, " "))
'
'Ret = MiObjeto.RegRead("HKEY_CLASSES_ROOT\WinZip\shell\open\command\")
'WinZip = Left(Ret, InStrRev(Ret, " "))
'Set MiObjeto = Nothing
'Command1.Caption = "Comprimir"
'Command2.Caption = "Descomprimir"
'If WinRar & WinZip = "" Then
' MsgBox "No se encuentra instalado ni WinZip ni WinRar :("
' End
'End If
Private Sub Form_Activate()
    
    Call gactualizaopcion(pbderecho_agregar, pbderecho_editar, pbderecho_borrar, pbderecho_imprimir)
    Call gactualiza_barra(Me)
    'lineas nuevas
        
    If GintCentralEstacion = 1 Then
       Opt_centralestacion.Value = True
       Opt_estacioncentral.Value = False
    Else
      If GintCentralEstacion = 0 Then
         Opt_centralestacion.Value = False
         Opt_estacioncentral.Value = True
       End If
    End If
                
                
    If pbderecho_consultar = False Then
        Unload Me
    End If
    
    
End Sub

Private Sub Form_Load()


On Error Resume Next
Dim MiObjeto As Object, Ret As String
Set MiObjeto = CreateObject("Wscript.Shell")
Ret = MiObjeto.RegRead("HKEY_CLASSES_ROOT\WinRAR\shell\open\command\")
WinRar = Left(Ret, InStrRev(Ret, " "))

Ret = MiObjeto.RegRead("HKEY_CLASSES_ROOT\WinZip\shell\open\command\")
WinZip = Left(Ret, InStrRev(Ret, " "))
Set MiObjeto = Nothing
Command1.Caption = "Comprimir"
Command2.Caption = "Descomprimir"
If WinRar & WinZip = "" Then
    MsgBox "No se encuentra instalado ni WinZip ni WinRar :("
    'end
End If


   Call gseguridad(Me)
    If pbderecho_consultar Then
        Set mobj_envios = New lib_trasmision.Cls_envios
        Set mobj_gen = New lib_trasmision.Cls_general
        Set mobj_sites = New DB_INV_MANTENIMIENTOS.C_ALMACEN
        Call cargalst_envioscentral
        DT_fecha.Value = Date - 1
        Set rs_sites = New ADODB.Recordset
        Set rs_sites = mobj_sites.ListarAlmacenesAyuda
        mstr_siteorigen = mobj_sites.Almacenoriginal
        mstr_nombresiteorigen = mobj_sites.ObtenerDescripcionAlmacen(mstr_siteorigen)
        mstr_ruta = mobj_envios.rutaenvio
        
        'Si no existe la ruta, toca crearla
        'Validar la existencia de la carpeta destino
        If Len(Trim$(Dir$(mstr_ruta, vbDirectory))) < 1 Then
            Call MkDir(mstr_ruta)
        End If
        
        If Right(Trim(mstr_ruta), 1) <> "\" Then    'DEBE TENER SLASH AL FINAL SI NO, AUMENTAR
            mstr_ruta = mstr_ruta + "\"
        End If
        ctrl_sites.llena_lista mobj_sites.ListarAlmacenesAyuda
        ctrl_sites.Size 25, 44
        Call genera_nombrearchivo(mstr_siteorigen)
    Else
    
    End If
    Me.Height = 6000
    Me.Width = 9645
    
End Sub
Sub cargalst_envioscentral()
Call carga_listbox(Lst_seguridad, mobj_envios.tablas_envioscentral("SE"))
Call carga_listbox(Lst_maestros, mobj_envios.tablas_envioscentral("MA"))
Call carga_listbox(Lst_inventarios, mobj_envios.tablas_envioscentral("IN"))
Call carga_listbox(LST_VENTAS, mobj_envios.tablas_envioscentral("OP"))
Call carga_listbox(LST_CTACTE, mobj_envios.tablas_envioscentral("AR"))
End Sub
Sub genera_nombrearchivo(ByVal idsite As String)

Dim sec As Integer
Dim str_archivo2 As String
Dim str_archivohisto As String
Dim Str_archivohistotemp As String
Dim Str_RutaHistorica As String

If Right(GstrRutaHistoricaTrans, 1) = "\" Then
   Str_RutaHistorica = GstrRutaHistoricaTrans
Else
   Str_RutaHistorica = GstrRutaHistoricaTrans + "\"
End If

sec = 1

If Opt_centralestacion.Value Then
    str_archivo = mstr_ruta + "CE" + Trim(idsite)
    str_archivohisto = Str_RutaHistorica + "CE" + Trim(idsite)
Else
    str_archivo = mstr_ruta + "EC" + Trim(idsite)
    str_archivohisto = Str_RutaHistorica + "EC" + Trim(idsite)
End If

str_archivo = str_archivo + String(4 - Len(Trim(Str(DT_fecha.Year))), "0") + Trim(Str(DT_fecha.Year))
str_archivo = str_archivo + String(2 - Len(Trim(Str(DT_fecha.Month))), "0") + Trim(Str(DT_fecha.Month))
str_archivo = str_archivo + String(2 - Len(Trim(Str(DT_fecha.Day))), "0") + Trim(Str(DT_fecha.Day))
str_archivo = str_archivo + "-"

str_archivohisto = str_archivohisto + String(4 - Len(Trim(Str(DT_fecha.Year))), "0") + Trim(Str(DT_fecha.Year))
str_archivohisto = str_archivohisto + String(2 - Len(Trim(Str(DT_fecha.Month))), "0") + Trim(Str(DT_fecha.Month))
str_archivohisto = str_archivohisto + String(2 - Len(Trim(Str(DT_fecha.Day))), "0") + Trim(Str(DT_fecha.Day))
str_archivohisto = str_archivohisto + "-"

Do While True
    str_archivo2 = str_archivo + Trim(Str(sec)) + ".MDB"
    Str_archivohistotemp = str_archivohisto + Trim(Str(sec)) + ".MDB"
    If Dir(Str_archivohistotemp) <> "" Then
       sec = sec + 1
    Else
            Exit Do
    End If
Loop

str_archivo = str_archivo2
Txt_archivo.Text = str_archivo

End Sub
Sub cargalst_enviosestacion()
Call carga_listbox(Lst_seguridad, mobj_envios.tablas_enviosestacion("SE"))
Call carga_listbox(Lst_maestros, mobj_envios.tablas_enviosestacion("MA"))
Call carga_listbox(Lst_inventarios, mobj_envios.tablas_enviosestacion("IN"))
Call carga_listbox(LST_VENTAS, mobj_envios.tablas_enviosestacion("OP"))
Call carga_listbox(LST_CTACTE, mobj_envios.tablas_enviosestacion("AR"))
End Sub

Sub carga_listbox(lst As ListBox, rs As ADODB.Recordset)
Dim items As Integer
Dim i As Integer

items = rs.RecordCount
lst.Clear
For i = 1 To items
    lst.AddItem (UCase(rs!TableId) + "-" + UCase(rs!tablename))
    lst.Selected(i - 1) = True
    rs.MoveNext
Next
lst.ListIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
 Set mobj_gen = Nothing
 Set mobj_envios = Nothing
End Sub

Private Sub Opt_centralestacion_Click()
Call cargalst_enviosestacion
'Call genera_nombrearchivo
Call genera_nombrearchivo(mstr_siteorigen)
End Sub
Private Sub Opt_estacioncentral_Click()
Call cargalst_envioscentral
Call genera_nombrearchivo(mstr_siteorigen)
End Sub
Sub selecciona_listbox(ByRef lst As ListBox)
Dim items As Integer
Dim i As Integer
items = lst.ListCount
For i = 1 To items
    lst.Selected(i - 1) = True
Next
lst.ListIndex = 0
End Sub

Sub deselecciona_listbox(lst As ListBox)
Dim items As Integer
Dim i As Integer
items = lst.ListCount
For i = 1 To items
    lst.Selected(i - 1) = False
Next
lst.ListIndex = 0
End Sub
Sub envia_tablas(ByVal str_tabla As String)

Dim li_elementos As Integer
Dim lstr_nombretabla As String
Dim lstr_tabladestino As String
Dim rs_temp As ADODB.Recordset  'almacenar los datos de la tabla
Dim li_nreg As Long
Dim li_contador As Long
Dim li_ncampos As Integer
Dim i As Long
Dim lstr_campo As String
Dim str_bd As String

Dim dbs As Database      'referencia a la base de datos
Dim tdfNuevo As TableDef 'nueva tabla
Dim li_tipocampo As Integer 'tipo del campo
Dim li_tamcampo As Double 'tamaño del campo
Dim li_precision As Integer 'precision para los campos numericos
Dim rs_tipo As ADODB.Recordset  'almacenar metadata de la tabla,tipo, direccion etc de la tabla
Dim LSTR_CAMPOFECHA As String
Dim LSTR_FECHA As String
Dim rs_destino As ADODB.Recordset
Dim fldTemp As Field
Dim lstr_tipo As String
Dim lbol_porsite As Integer
Dim lbol_RLSED As Integer

'Dim LSTR_SITE As String

LSTR_FECHA = CStr(DT_fecha.Value)
Set rs_tipo = mobj_gen.meta_tabla(str_tabla)
lstr_nombretabla = rs_tipo!tablename
LSTR_CAMPOFECHA = rs_tipo!DATEFIELD
lbol_porsite = IIf(rs_tipo!PERSITE, 1, 0)
lstr_tipo = rs_tipo!Type
lbol_RLSED = rs_tipo!RLSED

'---------------------------------------------------------
'crear la tabla
str_bd = str_archivo
Set dbs = OpenDatabase(str_bd)

'verificar que la tabla existe

If mobj_gen.existetabla(lstr_nombretabla) Then

    'recuperar los datos segun el tipo de tabla
    
    If lstr_tipo = "M" Then
        Set rs_temp = mobj_envios.datos_tabla_maestra(lstr_nombretabla, lbol_porsite, mstr_siteorigen)
    Else
       If Opt_estacioncentral.Value = True Then
          Set rs_temp = mobj_envios.datos_tabla_trans(lstr_nombretabla, LSTR_CAMPOFECHA, LSTR_FECHA, lbol_RLSED, 0, lbol_porsite, mstr_siteorigen)
       Else
          If Opt_centralestacion.Value = True Then
             Set rs_temp = mobj_envios.datos_tabla_trans(lstr_nombretabla, LSTR_CAMPOFECHA, LSTR_FECHA, lbol_RLSED, 1, lbol_porsite, mstr_siteorigen)
          End If
       End If
    End If

    li_ncampos = rs_temp.Fields.Count - 1

    lstr_tabladestino = str_tabla + "-" + lstr_nombretabla
    
    Set tdfNuevo = dbs.CreateTableDef(lstr_tabladestino)
    Txt_tabla.Text = lstr_nombretabla
    Me.Refresh
    
    For i = 0 To li_ncampos
        
        lstr_campo = UCase(rs_temp.Fields(i).Name)
        li_tipocampo = rs_temp.Fields(i).Type
        li_tamcampo = rs_temp.Fields(i).DefinedSize
        li_precision = rs_temp.Fields(i).Precision

        If li_tipocampo <> 128 Then 'no pasar timestap
            'crear tablas
           ' Crea un objeto TableDef nuevo, anexa los objetos  Field a la colección Fields y anexa el objeto
           ' TableDef a la colección TableDefs del objeto Database.

           Select Case li_tipocampo
            Case 129   'char
                tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbText, li_tamcampo)
            Case 200  'varchar
                Select Case li_tamcampo
                       Case Is > 255
                           tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbMemo)
                       Case Else
                           tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbText, li_tamcampo)
                End Select
                'tdfNuevo.AllowZeroLength = True
            Case 11 'boolean
                tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbBoolean)
            Case 135 'smalldatetime
                tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbDate)
            Case 131    'numeric
                tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbDouble)
            Case 5  'float
                tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbDouble)
            Case 2  'smallint
                tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbInteger)
            Case 3  'int
                tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbLong)
            Case 17  'tinynt
                tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbInteger)
            Case 201 'TEXTO
                tdfNuevo.Fields.Append tdfNuevo.CreateField(lstr_campo, dbText)
            Case Else
                    MsgBox rs_temp.Fields(i).Name + Chr(13) + "tipo:" + Str(rs_temp.Fields(i).Type) + Chr(13) + "size:" + Str(rs_temp.Fields(i).DefinedSize) + Chr(13) + "escala:" + Str(rs_temp.Fields(i).NumericScale) + Chr(13) + "precision" + Str(rs_temp.Fields(i).Precision), vbCritical, "Tipo Campo No Reconocido"
            End Select
            'crear la tabla
            End If  'fin de si es campo de timpo timestamp
        
        Next

        dbs.TableDefs.Append tdfNuevo
        '---------------------------------------------------------
        'grabar los datos SEGUN EL TIPO DE TABLA
        
        li_nreg = rs_temp.RecordCount
        pgb_avance.Value = 0
        li_contador = 0
        
        Dim db As ADODB.Connection
        Dim cadenaconexion As String
  
        Set db = New ADODB.Connection
        
        db.CursorLocation = adUseClient
        
        If GintProveedorAcces = 0 Then
           db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" + str_bd + ";"
        Else
           db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" + str_bd + ";"
        End If

        Set RSDESTINO = New ADODB.Recordset
        cadenaconexion = "select * from [" + lstr_tabladestino + "] where 1=2"

        RSDESTINO.Open cadenaconexion, db, adOpenKeyset, adLockOptimistic
        
        If rs_temp.RecordCount > 0 Then
            rs_temp.MoveFirst
            Do While Not rs_temp.EOF
                
                If (li_contador Mod 2000 = 0) And li_contador > 0 Then
                    RSDESTINO.Update
                    RSDESTINO.Close
                    RSDESTINO.Open cadenaconexion, db, adOpenKeyset, adLockOptimistic
                End If
                
                RSDESTINO.AddNew
                For i = 0 To li_ncampos
                    If rs_temp.Fields(i).Type <> 128 Then   'LOS CAMPOS TIMESTAMP DEBEN ESTAR AL FINAL Y NO SE TRANSFIEREN
                    
                    'SI ES UN CAMPO DE TEXTO Y ES DE LONJITUD CERO
                        If (rs_temp.Fields(i).Type = 129 Or rs_temp.Fields(i).Type = 200) And Len(rs_temp.Fields(i).Value) = 0 Then
                            RSDESTINO.Fields(i).Value = " "
                        Else
                            RSDESTINO.Fields(i).Value = rs_temp.Fields(i).Value
                        End If
                        
                        End If
                
                Next    'fin de bucle para los campos
                
                rs_temp.MoveNext
                
                li_contador = li_contador + 1
                txt_avance.Text = li_contador & " de " & li_nreg
                pgb_avance.Value = Round((100 / li_nreg) * li_contador, 0)
                Me.Refresh
               
            Loop
            
            RSDESTINO.Update 'grabar registro
    
        End If  ' fin del si hay registros
        'actualiza los flags si es una maestra especifica
        
        If lstr_tipo = "M" And lbol_porsite Then
           mobj_envios.FLAGENVIOMAESTRA lstr_nombretabla, 1, mstr_siteorigen, str_tabla, LSTR_FECHA, GCUSERID, str_archivo
        End If
        
        'Parte que puede ser anexada
        
        'If lsrt_tipo = "T" And Opt_centralestacion.Value Then
        
        'End If
        
        lst_tablas.AddItem (lstr_nombretabla + "," + Str(li_nreg) + " Registros ")
Else    'tabla no existe
    lst_tablas.AddItem ("     ********* " + lstr_nombretabla + " !!!!! No Existe")
End If
lst_tablas.ListIndex = lst_tablas.ListCount - 1

Set RSDESTINO = Nothing
Set rs_temp = Nothing

Me.Refresh

End Sub
Sub salir_formulario()
    Call Cmd_salir_Click
End Sub

Private Sub Cmd_salir_Click()
Unload Me
End Sub
Private Sub Cmd_sseguridad_Click()
selecciona_listbox Lst_seguridad
End Sub
Private Sub Command10_Click()
selecciona_listbox LST_CTACTE
End Sub
Private Sub Command11_Click()
deselecciona_listbox LST_CTACTE
End Sub
Private Sub Command2_Click()
deselecciona_listbox Lst_seguridad
End Sub
Private Sub Command4_Click()
selecciona_listbox Lst_maestros
End Sub
Private Sub Command5_Click()
deselecciona_listbox Lst_maestros
End Sub
Private Sub Command6_Click()
selecciona_listbox Lst_inventarios
End Sub
Private Sub Command7_Click()
deselecciona_listbox Lst_inventarios
End Sub
Private Sub Command8_Click()
selecciona_listbox LST_VENTAS
End Sub
Private Sub Command9_Click()
deselecciona_listbox LST_VENTAS
End Sub
Private Sub DT_fecha_Change()
Call genera_nombrearchivo(mstr_siteorigen)
End Sub
Sub flag_tablas(ByVal str_tabla As String)
Dim lstr_nombretabla As String
Dim rs_tipo As ADODB.Recordset  'almacenar metadata de la tabla,tipo, direccion etc de la tabla
Dim LSTR_CAMPOFECHA As String
Dim LSTR_FECHA As String
Dim lstr_tipo As String
Dim lbol_porsite As Integer

Set rs_tipo = mobj_gen.meta_tabla(str_tabla)
lstr_nombretabla = rs_tipo!tablename
LSTR_CAMPOFECHA = rs_tipo!DATEFIELD
lbol_porsite = IIf(rs_tipo!PERSITE, 1, 0)
lstr_tipo = rs_tipo!Type
LSTR_FECHA = CStr(DT_fecha.Value)

If mobj_gen.existetabla(lstr_nombretabla) Then
    If lstr_tipo = "M" And lbol_porsite = 0 Then
        mobj_envios.FLAGENVIOMAESTRA lstr_nombretabla, 0, mstr_siteorigen, str_tabla, LSTR_FECHA, GCUSERID, str_archivo
    End If
    
    If Opt_estacioncentral.Value = True Then
      If lstr_tipo = "T" Then
         mobj_envios.FLAGENVIOTRAN lstr_nombretabla, mstr_siteorigen, str_tabla, LSTR_FECHA, GCUSERID, LSTR_CAMPOFECHA, str_archivo, 0
      End If
    Else
       If Opt_centralestacion.Value = True Then
          If lstr_tipo = "T" Then
             mobj_envios.FLAGENVIOTRAN lstr_nombretabla, mstr_siteorigen, str_tabla, LSTR_FECHA, GCUSERID, LSTR_CAMPOFECHA, str_archivo, 1
          End If
       End If
    End If
    
End If

End Sub




