VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MsComCtl.ocx"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSComCt2.ocx"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form frmCliente 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Cliente"
   ClientHeight    =   8280
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10785
   Icon            =   "frmCliente.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   8280
   ScaleWidth      =   10785
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer Timer 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   120
      Top             =   120
   End
   Begin VB.CommandButton cmdEstandar 
      Cancel          =   -1  'True
      Caption         =   "&Cancelar"
      Height          =   375
      Index           =   1
      Left            =   9360
      TabIndex        =   35
      Top             =   7800
      Width           =   1335
   End
   Begin VB.CommandButton cmdEstandar 
      Caption         =   "&Aceptar"
      Default         =   -1  'True
      Height          =   375
      Index           =   0
      Left            =   7920
      TabIndex        =   34
      Top             =   7800
      Width           =   1335
   End
   Begin VB.Frame fraCliente 
      Height          =   7575
      Left            =   120
      TabIndex        =   30
      Top             =   120
      Width           =   10575
      Begin TabDlg.SSTab tabCliente 
         Height          =   3015
         Left            =   240
         TabIndex        =   32
         Top             =   4200
         Width           =   10095
         _ExtentX        =   17806
         _ExtentY        =   5318
         _Version        =   393216
         Tabs            =   2
         Tab             =   1
         TabHeight       =   520
         TabCaption(0)   =   "Tarjetas"
         TabPicture(0)   =   "frmCliente.frx":0442
         Tab(0).ControlEnabled=   0   'False
         Tab(0).Control(0)=   "cmdEditar(1)"
         Tab(0).Control(1)=   "cmdEditar(2)"
         Tab(0).Control(2)=   "cmdActivar"
         Tab(0).Control(3)=   "cmdEditar(3)"
         Tab(0).Control(4)=   "cmdEditar(0)"
         Tab(0).Control(5)=   "lvwTarjeta"
         Tab(0).Control(6)=   "lblLabels(10)"
         Tab(0).ControlCount=   7
         TabCaption(1)   =   "Estadística"
         TabPicture(1)   =   "frmCliente.frx":045E
         Tab(1).ControlEnabled=   -1  'True
         Tab(1).Control(0)=   "lblLabels(11)"
         Tab(1).Control(0).Enabled=   0   'False
         Tab(1).Control(1)=   "lblLabels(12)"
         Tab(1).Control(1).Enabled=   0   'False
         Tab(1).Control(2)=   "lblLabels(13)"
         Tab(1).Control(2).Enabled=   0   'False
         Tab(1).Control(3)=   "lvwEstadistica"
         Tab(1).Control(3).Enabled=   0   'False
         Tab(1).Control(4)=   "txtFUltTransaccion"
         Tab(1).Control(4).Enabled=   0   'False
         Tab(1).Control(5)=   "txtUltTransaccion"
         Tab(1).Control(5).Enabled=   0   'False
         Tab(1).ControlCount=   6
         Begin VB.TextBox txtUltTransaccion 
            BackColor       =   &H80000013&
            Enabled         =   0   'False
            Height          =   540
            Left            =   6840
            MultiLine       =   -1  'True
            TabIndex        =   43
            Top             =   2160
            Width           =   3015
         End
         Begin VB.TextBox txtFUltTransaccion 
            BackColor       =   &H80000013&
            Enabled         =   0   'False
            Height          =   315
            Left            =   6840
            TabIndex        =   41
            TabStop         =   0   'False
            Top             =   1320
            Width           =   1215
         End
         Begin VB.CommandButton cmdEditar 
            Caption         =   "&Editar"
            Height          =   375
            Index           =   1
            Left            =   -66480
            TabIndex        =   26
            Top             =   960
            Width           =   1335
         End
         Begin VB.CommandButton cmdEditar 
            Caption         =   "&Borrar"
            Height          =   375
            Index           =   2
            Left            =   -66480
            TabIndex        =   27
            Top             =   1440
            Width           =   1335
         End
         Begin VB.CommandButton cmdActivar 
            Caption         =   "Ac&tivar"
            Height          =   375
            Left            =   -66480
            TabIndex        =   29
            Top             =   2400
            Width           =   1335
         End
         Begin VB.CommandButton cmdEditar 
            Caption         =   "&Ver"
            Height          =   375
            Index           =   3
            Left            =   -66480
            TabIndex        =   28
            Top             =   1920
            Width           =   1335
         End
         Begin VB.CommandButton cmdEditar 
            Caption         =   "&Nuevo"
            Height          =   375
            Index           =   0
            Left            =   -66480
            TabIndex        =   25
            Top             =   480
            Width           =   1335
         End
         Begin MSComctlLib.ListView lvwTarjeta 
            Height          =   2055
            Left            =   -74760
            TabIndex        =   24
            Top             =   720
            Width           =   8055
            _ExtentX        =   14208
            _ExtentY        =   3625
            LabelEdit       =   1
            LabelWrap       =   -1  'True
            HideSelection   =   0   'False
            _Version        =   393217
            Icons           =   "imlTarjeta"
            SmallIcons      =   "imlTarjeta"
            ForeColor       =   -2147483640
            BackColor       =   -2147483643
            BorderStyle     =   1
            Appearance      =   1
            NumItems        =   0
         End
         Begin MSComctlLib.ListView lvwEstadistica 
            Height          =   2055
            Left            =   240
            TabIndex        =   39
            Top             =   720
            Width           =   6495
            _ExtentX        =   11456
            _ExtentY        =   3625
            LabelEdit       =   1
            LabelWrap       =   -1  'True
            HideSelection   =   0   'False
            _Version        =   393217
            Icons           =   "imlUsuario"
            SmallIcons      =   "imlUsuario"
            ForeColor       =   -2147483640
            BackColor       =   -2147483643
            BorderStyle     =   1
            Appearance      =   1
            NumItems        =   0
         End
         Begin VB.Label lblLabels 
            Caption         =   "UltimaTransacción"
            Height          =   375
            Index           =   13
            Left            =   6840
            TabIndex        =   42
            Top             =   1800
            Width           =   1455
         End
         Begin VB.Label lblLabels 
            Caption         =   "F.UltimaTransacción"
            Height          =   375
            Index           =   12
            Left            =   6840
            TabIndex        =   40
            Top             =   960
            Width           =   1455
         End
         Begin VB.Label lblLabels 
            Alignment       =   2  'Center
            BorderStyle     =   1  'Fixed Single
            Caption         =   "Estadística (Ultimos 12 meses)"
            Height          =   255
            Index           =   11
            Left            =   240
            TabIndex        =   38
            Top             =   480
            Width           =   6495
         End
         Begin VB.Label lblLabels 
            Alignment       =   2  'Center
            BorderStyle     =   1  'Fixed Single
            Caption         =   "Tarjetas"
            Height          =   255
            Index           =   10
            Left            =   -74760
            TabIndex        =   33
            Top             =   480
            Width           =   8055
         End
      End
      Begin VB.TextBox txtDistrito 
         Height          =   315
         Left            =   4560
         MaxLength       =   80
         TabIndex        =   16
         TabStop         =   0   'False
         Top             =   3000
         Width           =   2415
      End
      Begin VB.TextBox txtProvincia 
         Height          =   315
         Left            =   4560
         MaxLength       =   80
         TabIndex        =   13
         TabStop         =   0   'False
         Top             =   2640
         Width           =   2415
      End
      Begin VB.TextBox txtDepartamento 
         Height          =   315
         Left            =   4560
         MaxLength       =   80
         TabIndex        =   10
         TabStop         =   0   'False
         Top             =   2280
         Width           =   2415
      End
      Begin VB.CheckBox chkFNacimiento 
         Caption         =   "F.Nacimiento"
         Height          =   255
         Left            =   4200
         TabIndex        =   19
         Top             =   3360
         Width           =   1335
      End
      Begin VB.TextBox txtEMail 
         Height          =   315
         Left            =   1800
         MaxLength       =   80
         TabIndex        =   22
         TabStop         =   0   'False
         Top             =   3720
         Width           =   5175
      End
      Begin VB.TextBox txtTelefono 
         Height          =   315
         Left            =   1800
         MaxLength       =   50
         TabIndex        =   18
         TabStop         =   0   'False
         Top             =   3360
         Width           =   1935
      End
      Begin VB.Frame fraFoto 
         Height          =   2535
         Left            =   7320
         TabIndex        =   31
         Top             =   960
         Width           =   2895
         Begin VB.Image imgFoto 
            Height          =   2145
            Left            =   120
            Top             =   240
            Width           =   2640
         End
      End
      Begin VB.CommandButton cmdFoto 
         Caption         =   "&Fotografiar"
         Height          =   375
         Left            =   7320
         TabIndex        =   23
         Top             =   3720
         Width           =   3015
      End
      Begin VB.TextBox txtDireccion 
         Height          =   895
         Left            =   1800
         MaxLength       =   255
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   7
         Top             =   1320
         Width           =   5175
      End
      Begin VB.TextBox txtNombres 
         Height          =   315
         Left            =   1800
         MaxLength       =   50
         TabIndex        =   5
         Top             =   960
         Width           =   5175
      End
      Begin VB.TextBox txtApellidos 
         Height          =   315
         Left            =   1800
         MaxLength       =   50
         TabIndex        =   3
         Top             =   600
         Width           =   5175
      End
      Begin VB.TextBox txtTarjeta 
         Height          =   315
         Left            =   1800
         MaxLength       =   8
         TabIndex        =   1
         Top             =   240
         Width           =   1215
      End
      Begin MSDataListLib.DataCombo dcbDepartamento 
         Bindings        =   "frmCliente.frx":047A
         Height          =   315
         Left            =   1800
         TabIndex        =   9
         Top             =   2280
         Width           =   2535
         _ExtentX        =   4471
         _ExtentY        =   556
         _Version        =   393216
         Style           =   2
         ListField       =   "sLocaName"
         BoundColumn     =   "cDepaCode"
         Text            =   ""
      End
      Begin MSDataListLib.DataCombo dcbProvincia 
         Bindings        =   "frmCliente.frx":0498
         Height          =   315
         Left            =   1800
         TabIndex        =   12
         Top             =   2640
         Width           =   2535
         _ExtentX        =   4471
         _ExtentY        =   556
         _Version        =   393216
         Style           =   2
         ListField       =   "sLocaName"
         BoundColumn     =   "cProvCode"
         Text            =   ""
      End
      Begin MSDataListLib.DataCombo dcbDistrito 
         Bindings        =   "frmCliente.frx":04B3
         Height          =   315
         Left            =   1800
         TabIndex        =   15
         Top             =   3000
         Width           =   2535
         _ExtentX        =   4471
         _ExtentY        =   556
         _Version        =   393216
         Style           =   2
         ListField       =   "sLocaName"
         BoundColumn     =   "cDistCode"
         Text            =   ""
      End
      Begin MSComCtl2.DTPicker dtpFNacimiento 
         Height          =   315
         Left            =   5760
         TabIndex        =   20
         Top             =   3360
         Width           =   1215
         _ExtentX        =   2143
         _ExtentY        =   556
         _Version        =   393216
         CalendarForeColor=   -2147483640
         CalendarTitleBackColor=   -2147483645
         CalendarTitleForeColor=   -2147483629
         CalendarTrailingForeColor=   -2147483645
         CustomFormat    =   "dd/MM/yyyy"
         Format          =   58392579
         CurrentDate     =   37042
      End
      Begin VB.Label lblLabels 
         Alignment       =   2  'Center
         Caption         =   "Moy Park"
         BeginProperty Font 
            Name            =   "Georgia"
            Size            =   26.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   855
         Index           =   7
         Left            =   7440
         TabIndex        =   44
         Top             =   240
         Width           =   3015
      End
      Begin VB.Label lblTickets 
         Caption         =   "Tickets"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   4560
         TabIndex        =   37
         Top             =   240
         Width           =   2415
      End
      Begin VB.Label lblPuntos 
         Caption         =   "Puntos"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   1800
         TabIndex        =   36
         Top             =   240
         Width           =   2415
      End
      Begin VB.Label lblLabels 
         Caption         =   "E-&Mail"
         Height          =   375
         Index           =   9
         Left            =   240
         TabIndex        =   21
         Top             =   3720
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Telé&fono"
         Height          =   375
         Index           =   8
         Left            =   240
         TabIndex        =   17
         Top             =   3360
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Di&strito"
         Height          =   375
         Index           =   6
         Left            =   240
         TabIndex        =   14
         Top             =   3000
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "&Provincia"
         Height          =   375
         Index           =   5
         Left            =   240
         TabIndex        =   11
         Top             =   2640
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "De&partamento"
         Height          =   375
         Index           =   4
         Left            =   240
         TabIndex        =   8
         Top             =   2280
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "&Dirección"
         Height          =   375
         Index           =   3
         Left            =   240
         TabIndex        =   6
         Top             =   1560
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "&Nombres"
         Height          =   375
         Index           =   2
         Left            =   240
         TabIndex        =   4
         Top             =   1080
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Ape&llidos"
         Height          =   375
         Index           =   1
         Left            =   240
         TabIndex        =   2
         Top             =   720
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Nuevo Nro. &Tarjeta"
         Height          =   375
         Index           =   0
         Left            =   240
         TabIndex        =   0
         Top             =   360
         Width           =   1455
      End
   End
   Begin MSAdodcLib.Adodc adoDepartamento 
      Height          =   330
      Left            =   3960
      Top             =   7920
      Visible         =   0   'False
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin MSAdodcLib.Adodc adoProvincia 
      Height          =   330
      Left            =   5160
      Top             =   7920
      Visible         =   0   'False
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin MSAdodcLib.Adodc adoDistrito 
      Height          =   330
      Left            =   6360
      Top             =   7920
      Visible         =   0   'False
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin MSComctlLib.ImageList imlTarjeta 
      Left            =   3240
      Top             =   7800
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmCliente.frx":04CD
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmCliente.frx":091F
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmCliente"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim bTarjetaFlag As Boolean

Dim sActualFoto As String
Dim sPrefijoFoto As String
Dim sExtensionFoto As String
Dim sNombreVentana As String

Dim iTiempo As Integer

Public sCodigo As String
Public iEditar As Integer
Dim sFoto As String

Const kDEPARTAMENTO_LIMA = 150
Const kPROVINCIA_LIMA = 10
Const kLOCALIDAD_OTROS = 999

Private Sub Form_Load()

  'Cargar formulario
  
  On Error GoTo LineaError

  Screen.MousePointer = vbHourglass
  
  LlenarComboDepartamento
  ConfigurarColumnas
  InicializarForm
  
  Screen.MousePointer = vbDefault
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

End Sub

Private Sub Form_Unload(Cancel As Integer)

  If sNombreVentana <> "" Then CerrarAplicacion (sNombreVentana)

End Sub

Private Sub LlenarComboDepartamento()

  'Carga combo Departamento

  On Error GoTo LineaError
  
  With adoDepartamento
    .ConnectionString = kCONNECT_STRING + psRutaMdb
    .RecordSource = "SELECT * " + _
                    "FROM Localidad " + _
                    "WHERE cProvCode = 0 AND " + _
                    "cDistCode = 0 " + _
                    "UNION " + _
                    "SELECT * " + _
                    "FROM Localidad " + _
                    "WHERE cDepaCode = 999 AND " + _
                    "cProvCode = 999 AND " + _
                    "cDistCode = 999 " + _
                    "ORDER BY sLocaName"
    .Refresh
  End With
  
  If Not adoDepartamento.Recordset.EOF Then
    dcbDepartamento.BoundText = kDEPARTAMENTO_LIMA
  End If
  
  Exit Sub
  
LineaError:
  Screen.MousePointer = vbDefault

End Sub

Private Sub LlenarComboProvincia()

  'Carga combo Provincia

  On Error GoTo LineaError

  Dim sSQL As String

  sSQL = "SELECT * " + _
         "FROM Localidad " + _
         "WHERE TRIM(cDepaCode) = TRIM('$') AND " + _
         "cProvCode <> 0 AND " + _
         "cDistCode = 0 " + _
         "UNION " + _
         "SELECT * " + _
         "FROM Localidad " + _
         "WHERE cDepaCode = 999 AND " + _
         "cProvCode = 999 AND " + _
         "cDistCode = 999 " + _
         "ORDER BY sLocaName"

  With adoProvincia
    .ConnectionString = kCONNECT_STRING + psRutaMdb
    .RecordSource = VBsprintf(sSQL, dcbDepartamento.BoundText)
    .Refresh
  End With

  If Not adoProvincia.Recordset.EOF Then
  
    If dcbDepartamento.BoundText = kDEPARTAMENTO_LIMA Then
      dcbProvincia.BoundText = kPROVINCIA_LIMA
    Else
      dcbProvincia.BoundText = adoProvincia.Recordset!cProvCode
    End If
    
  End If
  
  Exit Sub
  
LineaError:
  Screen.MousePointer = vbDefault

End Sub

Private Sub LlenarComboDistrito()

  'Carga combo Distrito

  On Error GoTo LineaError

  Dim sSQL As String

  sSQL = "SELECT * " + _
         "FROM Localidad " + _
         "WHERE TRIM(cDepaCode) = TRIM('$') AND " + _
         "TRIM(cProvCode) = TRIM('$') AND " + _
         "cDistCode <> 0 " + _
         "UNION " + _
         "SELECT * " + _
         "FROM Localidad " + _
         "WHERE cDepaCode = 999 AND " + _
         "cProvCode = 999 AND " + _
         "cDistCode = 999 " + _
         "ORDER BY sLocaName"

  With adoDistrito
    .ConnectionString = kCONNECT_STRING + psRutaMdb
    .RecordSource = VBsprintf(sSQL, dcbDepartamento.BoundText, dcbProvincia.BoundText)
    .Refresh
  End With

  If Not adoDistrito.Recordset.EOF Then
    dcbDistrito.BoundText = adoDistrito.Recordset!cDistCode
  End If
  
  Exit Sub
  
LineaError:
  Screen.MousePointer = vbDefault
  
End Sub

Private Sub dcbDepartamento_Change()

  'Invoca a la funcion q carga el combo Provincia
  'Habilita o deshabilita el texto departamento según se haya escogido el valor OTROS o no

  On Error GoTo LineaError

  LlenarComboProvincia
    
  If dcbDepartamento.BoundText = kLOCALIDAD_OTROS Then
    Call HabilitarControl(txtDepartamento, True)
    On Error Resume Next
    txtDepartamento.SetFocus
  Else
    Call DeshabilitarControl(txtDepartamento, True)
  End If

  Exit Sub
  
LineaError:
  Screen.MousePointer = vbDefault

End Sub

Private Sub dcbProvincia_Change()

  'Invoca a la funcion q carga el combo Distrito
  'Habilita o deshabilita el texto provincia según se haya escogido el valor OTROS o no

  On Error GoTo LineaError

  LlenarComboDistrito
  
  If dcbProvincia.BoundText = kLOCALIDAD_OTROS Then
    Call HabilitarControl(txtProvincia, True)
    On Error Resume Next
    txtProvincia.SetFocus
  Else
    Call DeshabilitarControl(txtProvincia, True)
  End If
  
  Exit Sub
  
LineaError:
  Screen.MousePointer = vbDefault

End Sub

Private Sub dcbDistrito_Change()

  'Habilita o deshabilita el texto distrito según se haya escogido el valor OTROS o no

  On Error GoTo LineaError
  
  If dcbDistrito.BoundText = kLOCALIDAD_OTROS Then
    Call HabilitarControl(txtDistrito, True)
    On Error Resume Next
    txtDistrito.SetFocus
  Else
    Call DeshabilitarControl(txtDistrito, True)
  End If
  
  Exit Sub
  
LineaError:
  Screen.MousePointer = vbDefault
  
End Sub

Private Sub ConfigurarColumnas()

  'Configura las columnas de la lista lvwTarjeta
  
  On Error GoTo LineaError

  Dim aColumnTitle() As String
  Dim aColumnWidth() As Single
  Dim aColumnAlign() As Integer
  
  ReDim aColumnTitle(3) As String
  ReDim aColumnWidth(3) As Single
  ReDim aColumnAlign(3) As Integer

  aColumnTitle(0) = "Tarjeta"
  aColumnTitle(1) = "F.Emision"
  aColumnTitle(2) = "Usuario"
  
  aColumnWidth(0) = 0.25
  aColumnWidth(1) = 0.25
  aColumnWidth(2) = 0.45
  
  aColumnAlign(0) = lvwColumnLeft
  aColumnAlign(1) = lvwColumnLeft
  aColumnAlign(2) = lvwColumnLeft
    
  Call oListAdmin.InicializarLista(lvwTarjeta, aColumnTitle, _
                                   aColumnWidth, aColumnAlign, lvwReport)
                                   
  ReDim aColumnTitle(7) As String
  ReDim aColumnWidth(7) As Single
  ReDim aColumnAlign(7) As Integer

  aColumnTitle(0) = "Mes/Año"
  aColumnTitle(1) = "Puntos Acum."
  aColumnTitle(2) = "Tickets Acum."
  aColumnTitle(3) = "Ajuste Puntos Acum."
  aColumnTitle(4) = "Ajuste Tickets Acum."
  aColumnTitle(5) = "Puntos Canj."
  aColumnTitle(6) = "Tickets Canj."
  
  aColumnWidth(0) = 0.15
  aColumnWidth(1) = 0.2
  aColumnWidth(2) = 0.2
  aColumnWidth(3) = 0.2
  aColumnWidth(4) = 0.2
  aColumnWidth(5) = 0.2
  aColumnWidth(6) = 0.2
  
  aColumnAlign(0) = lvwColumnLeft
  aColumnAlign(1) = lvwColumnRight
  aColumnAlign(2) = lvwColumnRight
  aColumnAlign(3) = lvwColumnRight
  aColumnAlign(4) = lvwColumnRight
  aColumnAlign(5) = lvwColumnRight
  aColumnAlign(6) = lvwColumnRight
    
  Call oListAdmin.InicializarLista(lvwEstadistica, aColumnTitle, _
                                   aColumnWidth, aColumnAlign, lvwReport)
                                   
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub InicializarForm()

  'Inicializa Form según opción

  On Error GoTo LineaError
  
  bTarjetaFlag = False
  
  chkFNacimiento.Value = kSI
  dtpFNacimiento.Value = Date
  tabCliente.Tab = 0
  
  Select Case iEditar

  Case kCMD_NUEVO
    Me.Caption = "Nuevo Cliente"
    EsconderControles

  Case kCMD_EDITAR
    Me.Caption = "Editar Cliente"
    TraerData
    EsconderControles

  Case kCMD_BORRAR
    Me.Caption = "Borrar Cliente"
    TraerData
    EsconderControles
    DeshabilitarControles

  Case kCMD_VER
    Me.Caption = "Cliente"
    TraerData
    EsconderControles
    DeshabilitarControles

  End Select
  
  ManejarControles

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub TraerData()

  'Trae la data de la tabla Cliente

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset

  Dim iPos As Integer

  If psForm = kFORM_PRINCIPAL Then
    sCodigo = Mid(frmPrincipal.lvwCliente.SelectedItem.Key, 2)
  ElseIf psForm = kFORM_ACUMULACION_FECHA Then
    If psLista = kPUNTO Then
      sCodigo = Mid(frmAcumulacionFecha.lvwPunto.SelectedItem.Key, 2, 10)
    Else
      sCodigo = Mid(frmAcumulacionFecha.lvwTicket.SelectedItem.Key, 2, 10)
    End If
  ElseIf psForm = kFORM_CANJE_FECHA Then
    If psLista = kPUNTO Then
      sCodigo = Mid(frmCanjeFecha.lvwCanjePunto.SelectedItem.Key, 2, 10)
    Else
      sCodigo = Mid(frmCanjeFecha.lvwCanjeTicket.SelectedItem.Key, 2, 10)
    End If
  End If

  sSQL = "SELECT a.*, b.* FROM Cliente a, Transaccion b " + _
         "WHERE a.cTranCode = b.cTranCode AND cClieCode = $"
  sSQL = VBsprintf(sSQL, sCodigo)

  If oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then

    If Not ADORS.EOF Then

      txtApellidos.Text = LeerCampo(ADORS!sClieApel)
      txtNombres.Text = LeerCampo(ADORS!sClieName)
      txtDireccion.Text = LeerCampo(ADORS!sClieAddr)
      
      dcbDepartamento.BoundText = LeerCampo(ADORS!cDepaCode)
      
      If dcbDepartamento.BoundText = kLOCALIDAD_OTROS Then
        txtDepartamento.Text = LeerCampo(ADORS!sDepaDesc)
      End If
      
      dcbProvincia.BoundText = LeerCampo(ADORS!cProvCode)
      
      If dcbProvincia.BoundText = kLOCALIDAD_OTROS Then
        txtProvincia.Text = LeerCampo(ADORS!sProvDesc)
      End If
      
      dcbDistrito.BoundText = LeerCampo(ADORS!cDistCode)
      
      If dcbDistrito.BoundText = kLOCALIDAD_OTROS Then
        txtDistrito.Text = LeerCampo(ADORS!sDistDesc)
      End If
      
      txtTelefono.Text = LeerCampo(ADORS!sClieTelf)
      txtEMail.Text = LeerCampo(ADORS!sClieMail)
      
      If LeerCampo(ADORS!dNacmDate) <> "" Then
        chkFNacimiento.Value = kSI
        dtpFNacimiento.Value = LeerCampo(ADORS!dNacmDate)
      Else
        chkFNacimiento.Value = kNO
      End If
      
      txtFUltTransaccion.Text = Format(LeerCampo(ADORS!dUltTDate), "dd/mm/yyyy")
      txtUltTransaccion.Text = LeerCampo(ADORS!sTranDesc)
      
      lblPuntos.Caption = "Puntos: " + Format(LeerCampo(ADORS!nPuntCant), "##,##0")
      lblTickets.Caption = "Tickets: " + Format(LeerCampo(ADORS!nTickCant), "##,##0")

      sFoto = LeerCampo(ADORS!sClieRout)

      If sFoto <> "" Then

        If Dir(sFoto) = "" Then

          iPos = InStrRev(sFoto, "\")

          If iPos > 0 Then
            sFoto = App.Path + IIf(Right(App.Path, 1) = "\", "", "\") + kDIR_FOTOS + Mid(sFoto, iPos + 1)
          End If

        End If

        If Dir(sFoto) <> "" Then
          fraFoto.Caption = Dir(sFoto)
          imgFoto.Picture = LoadPicture(sFoto)
        End If

      End If
      
      Set ADORS = Nothing
                  
      LlenarLista
    
    End If

  End If
  
  Set ADORS = Nothing

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub LlenarLista()

  'Llena las listas

  On Error GoTo LineaError
  
  LlenarListaTarjeta
  
  If lvwTarjeta.ListItems.Count > 0 Then
    LlenarListaEstadistica
  End If
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub LlenarListaTarjeta()

  'Llena la lista Tarjeta

  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Dim itemX As ListItem
  
  sSQL = "SELECT * FROM Tarjeta WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, sCodigo)
  
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
  Do While Not ADORS.EOF
  
    Set itemX = lvwTarjeta.ListItems.Add(, , LeerCampo(ADORS!nTarjNumb))
    itemX.SubItems(1) = Format(LeerCampo(ADORS!dEmisDate), "dd/mm/yyyy hh:mm")
    itemX.SubItems(2) = LeerCampo(ADORS!sUserDesc)
    
    If LeerCampo(ADORS!cTarjActi) = kSI Then
      itemX.Icon = 1
      itemX.SmallIcon = 1
    Else
      itemX.Icon = 2
      itemX.SmallIcon = 2
    End If
      
    ADORS.MoveNext
    
  Loop
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing

End Sub

Private Sub LlenarListaEstadistica()

  'Llena la lista Estadistica
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Dim i As Integer
  Dim iMes As Integer
  Dim iAño As Integer
  
  Dim iMesAnt As Integer
  Dim iAñoAnt As Integer
  
  Dim sPuntoAcum As String
  Dim sTicketAcum As String
  Dim sAjustePunto As String
  Dim sAjusteTicket As String
  Dim sPuntoCanj As String
  Dim sTicketCanj As String
  
  Dim itemX As ListItem

  On Error GoTo LineaError
  
  sSQL = "SELECT MIN(dEmisDate) AS dFecha FROM Tarjeta WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, sCodigo)
  
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
  If ADORS.EOF Then GoTo Salir
  
  iMesAnt = Month(LeerCampo(ADORS!dFecha))
  iAñoAnt = Year(LeerCampo(ADORS!dFecha))

  iMes = Month(Date)
  iAño = Year(Date)
  
  For i = 1 To 12
  
    If CStr(iAñoAnt) + LPad(CStr(iMesAnt), 2, "0") > CStr(iAño) + LPad(CStr(iMes), 2, "0") Then Exit For
  
    sSQL = "SELECT SUM(nPuntCant) AS Suma FROM Acumulacion_Punto " + _
           "WHERE cClieCode = $ AND MONTH(dAcumDate) = $ AND " + _
           "YEAR(dAcumDate) = $ AND dExtoDate IS NULL AND " + _
           "cAjusFlag <> $"
    sSQL = VBsprintf(sSQL, sCodigo, iMes, iAño, kSI)
    
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
    sPuntoAcum = "0"
    
    If Not ADORS.EOF Then
      sPuntoAcum = IIf(LeerCampo(ADORS!Suma) = "", "0", LeerCampo(ADORS!Suma))
    End If
        
    sSQL = "SELECT SUM(nTickCant) AS Suma FROM Acumulacion_Ticket " + _
           "WHERE cClieCode = $ AND MONTH(dAcumDate) = $ AND " + _
           "YEAR(dAcumDate) = $ AND dExtoDate IS NULL AND " + _
           "cAjusFlag <> $"
    sSQL = VBsprintf(sSQL, sCodigo, iMes, iAño, kSI)
    
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
    sTicketAcum = "0"
    
    If Not ADORS.EOF Then
      sTicketAcum = IIf(LeerCampo(ADORS!Suma) = "", "0", LeerCampo(ADORS!Suma))
    End If
    
    sSQL = "SELECT SUM(nPuntCant) AS Suma FROM Acumulacion_Punto " + _
           "WHERE cClieCode = $ AND MONTH(dAcumDate) = $ AND " + _
           "YEAR(dAcumDate) = $ AND dExtoDate IS NULL AND " + _
           "cAjusFlag = $"
    sSQL = VBsprintf(sSQL, sCodigo, iMes, iAño, kSI)
    
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
    sAjustePunto = "0"
    
    If Not ADORS.EOF Then
      sAjustePunto = IIf(LeerCampo(ADORS!Suma) = "", "0", LeerCampo(ADORS!Suma))
    End If
    
    sSQL = "SELECT SUM(nTickCant) AS Suma FROM Acumulacion_Ticket " + _
           "WHERE cClieCode = $ AND MONTH(dAcumDate) = $ AND " + _
           "YEAR(dAcumDate) = $ AND dExtoDate IS NULL AND " + _
           "cAjusFlag = $"
    sSQL = VBsprintf(sSQL, sCodigo, iMes, iAño, kSI)
    
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
    sAjusteTicket = "0"
    
    If Not ADORS.EOF Then
      sAjusteTicket = IIf(LeerCampo(ADORS!Suma) = "", "0", LeerCampo(ADORS!Suma))
    End If
    
    sSQL = "SELECT SUM(nPuntCant) AS Suma FROM Canje_Punto " + _
           "WHERE cClieCode = $ AND MONTH(dCanjDate) = $ AND " + _
           "YEAR(dCanjDate) = $ AND dExtoDate IS NULL "
    sSQL = VBsprintf(sSQL, sCodigo, iMes, iAño)
    
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
    sPuntoCanj = "0"
    
    If Not ADORS.EOF Then
      sPuntoCanj = IIf(LeerCampo(ADORS!Suma) = "", "0", LeerCampo(ADORS!Suma))
    End If
    
    sSQL = "SELECT SUM(nTickCant) AS Suma FROM Canje_Ticket " + _
           "WHERE cClieCode = $ AND MONTH(dCanjDate) = $ AND " + _
           "YEAR(dCanjDate) = $ AND dExtoDate IS NULL "
    sSQL = VBsprintf(sSQL, sCodigo, iMes, iAño)
    
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
    sTicketCanj = "0"
    
    If Not ADORS.EOF Then
      sTicketCanj = IIf(LeerCampo(ADORS!Suma) = "", "0", LeerCampo(ADORS!Suma))
    End If
    
    Set itemX = lvwEstadistica.ListItems.Add(, , LPad(CStr(iMes), 2, "0") + "/" + CStr(iAño))
    itemX.SubItems(1) = Format(sPuntoAcum, "##,##0")
    itemX.SubItems(2) = Format(sTicketAcum, "##,##0")
    itemX.SubItems(3) = Format(sAjustePunto, "##,##0")
    itemX.SubItems(4) = Format(sAjusteTicket, "##,##0")
    itemX.SubItems(5) = Format(sPuntoCanj, "##,##0")
    itemX.SubItems(6) = Format(sTicketCanj, "##,##0")
    
    iMes = iMes - 1
    
    If iMes = 0 Then
      iMes = 12
      iAño = iAño - 1
    End If
    
  Next
  
  GoTo Salir

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing

End Sub

Private Sub EsconderControles()

  'Esconde controles

  On Error GoTo LineaError
  
  If iEditar = kCMD_NUEVO Then
    lblLabels(0).Visible = True
    txtTarjeta.Visible = True
    lblPuntos.Visible = False
    lblTickets.Visible = False
  Else
    lblLabels(0).Visible = False
    txtTarjeta.Visible = False
    lblPuntos.Visible = True
    lblTickets.Visible = True
  End If

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub DeshabilitarControles()

  'Deshabilita controles

  On Error GoTo LineaError

  Call DeshabilitarControl(txtApellidos, True)
  Call DeshabilitarControl(txtNombres, True)
  Call DeshabilitarControl(txtDireccion, True)
  Call DeshabilitarControl(dcbDepartamento, True)
  Call DeshabilitarControl(txtDepartamento, False)
  Call DeshabilitarControl(dcbProvincia, False)
  Call DeshabilitarControl(txtProvincia, False)
  Call DeshabilitarControl(dcbDistrito, False)
  Call DeshabilitarControl(txtDistrito, False)
  Call DeshabilitarControl(txtTelefono, False)
  Call DeshabilitarControl(txtEMail, False)
  Call DeshabilitarControl(chkFNacimiento, False)
  Call DeshabilitarControl(dtpFNacimiento, False)
  Call DeshabilitarControl(cmdFoto, False)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub


Private Sub chkFNacimiento_Click()

  'Habilita o no el control de fechas

  On Error GoTo LineaError
  
  If chkFNacimiento.Value = kSI Then
    Call HabilitarControl(dtpFNacimiento, False)
  Else
    Call DeshabilitarControl(dtpFNacimiento, False)
  End If
  
  dtpFNacimiento.Value = Date
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtApellidos_KeyPress(KeyAscii As Integer)

  'Convierte cada caracter digitado a mayúsculas

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_UPPER_CASE)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtNombres_KeyPress(KeyAscii As Integer)

  'Convierte cada caracter digitado a mayúsculas

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_UPPER_CASE)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtDireccion_KeyPress(KeyAscii As Integer)

  'Convierte cada caracter digitado a mayúsculas

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_UPPER_CASE)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtDepartamento_KeyPress(KeyAscii As Integer)

  'Convierte cada caracter digitado a mayúsculas

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_UPPER_CASE)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtProvincia_KeyPress(KeyAscii As Integer)

  'Convierte cada caracter digitado a mayúsculas

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_UPPER_CASE)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtDistrito_KeyPress(KeyAscii As Integer)

  'Convierte cada caracter digitado a mayúsculas

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_UPPER_CASE)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtTarjeta_KeyPress(KeyAscii As Integer)

  'Valida q se ingrese solo valores numéricos (enteros)

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_INTEGER_ONLY)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtTelefono_KeyPress(KeyAscii As Integer)

  'Convierte cada caracter digitado a mayúsculas

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_UPPER_CASE)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub


Public Sub ManejarControles()

  'Maneja el uso de los controles
  
  On Error GoTo LineaError

  Call DeshabilitarControl(cmdEditar(kCMD_NUEVO), False)
  Call DeshabilitarControl(cmdEditar(kCMD_EDITAR), False)
  Call DeshabilitarControl(cmdEditar(kCMD_BORRAR), False)
  Call DeshabilitarControl(cmdEditar(kCMD_VER), False)
  Call DeshabilitarControl(cmdActivar, False)
  
  If iEditar = kCMD_EDITAR Then
    Call HabilitarControl(cmdEditar(kCMD_NUEVO), False)
  End If

  If lvwTarjeta.ListItems.Count > 0 Then
    
    lvwTarjeta.SelectedItem.EnsureVisible
    
    If lvwTarjeta.SelectedItem.SmallIcon = 1 Then
      cmdActivar.Caption = "Desac&tivar"
    Else
      cmdActivar.Caption = "Ac&tivar"
    End If
    
    If piPerfil_Codigo = kPERFIL_ADMINISTRADOR Or piPerfil_Codigo = kPERFIL_SUPERVISOR And _
    iEditar = kCMD_EDITAR Then
    
      Call HabilitarControl(cmdEditar(kCMD_EDITAR), False)
      Call HabilitarControl(cmdEditar(kCMD_BORRAR), False)
      Call HabilitarControl(cmdActivar, False)
      
    End If
    
    Call HabilitarControl(cmdEditar(kCMD_VER), False)
    
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub cmdFoto_Click()

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

  Screen.MousePointer = vbHourglass
  
  sSQL = "SELECT * FROM Configuracion"
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
  If ADORS.EOF Then
    
    MsgBox "No se ha definido configuración para el uso de la aplicación del WebCam. Consultar a su proveedor de servicios.", vbOKOnly + vbInformation
    
  Else
  
    If LeerCampo(ADORS!sWebCName) = "" Or LeerCampo(ADORS!sWebCRout) = "" Then
    
      MsgBox "No se ha definido configuración para el uso de la aplicación del WebCam. Consultar a su proveedor de servicios.", vbOKOnly + vbInformation
      
    Else
    
      If Dir(LeerCampo(ADORS!sWebCRout)) = "" Then
        
        MsgBox "Ruta de la aplicación del WebCam definida en la configuración no es válida. Consultar a su proveedor de servicios.", vbOKOnly + vbInformation
        GoTo Salir
      End If
    
      sNombreVentana = LeerCampo(ADORS!sWebCName)
      CerrarAplicacion (sNombreVentana)
      
      sRutaFotosNuevas = App.Path + IIf(Right(App.Path, 1) = "\", "", "\") + kDIR_FOTOS_NUEVAS

      If Dir(sRutaFotosNuevas, vbDirectory) = "" Then
        MkDir (sRutaFotosNuevas)
      End If
      
      If Dir(sRutaFotosNuevas) <> "" Then
        Kill sRutaFotosNuevas + "*.*"
      End If
      
      If LeerCampo(ADORS!nUFotNumb) = "" Then
        sActualFoto = "0"
      Else
        sActualFoto = CStr(CLng(LeerCampo(ADORS!nUFotNumb)) + 1)
      End If
                  
      Call Shell(LeerCampo(ADORS!sWebCRout), vbNormalFocus)
      
      sPrefijoFoto = LeerCampo(ADORS!sFotoPref)
      sExtensionFoto = LeerCampo(ADORS!sFotoExte)
      
      iTiempo = 0
      Timer.Enabled = True
      
    End If
  
  End If
  
Salir:
  Set ADORS = Nothing
  Screen.MousePointer = vbDefault

End Sub

Private Sub Timer_Timer()

  Dim sRutaFotosNuevas As String
  Dim sRutaFotos As String
  
  Dim sNombreFotoNueva As String
  Dim sNombreFoto As String
  
  Dim sSQL As String
  
  Dim sNumFotoMayor As String
  Dim sNumFotoActual As String
  
  iTiempo = iTiempo + 1
  
  If iTiempo = 60 Then
    Timer.Enabled = False
    CerrarAplicacion (sNombreVentana)
    Exit Sub
  End If
  
  sRutaFotosNuevas = App.Path + IIf(Right(App.Path, 1) = "\", "", "\") + kDIR_FOTOS_NUEVAS

  If Dir(sRutaFotosNuevas, vbDirectory) = "" Then
    MkDir (sRutaFotosNuevas)
  End If
    
  sNombreFotoNueva = Dir(sRutaFotosNuevas)
  
  sNumFotoMayor = "-1"
  
  Do While sNombreFotoNueva <> ""
  
    If UCase(Right(sNombreFotoNueva, Len(sExtensionFoto) + 1)) = UCase("." + sExtensionFoto) Then
  
      sNumFotoActual = Mid(sNombreFotoNueva, Len(sPrefijoFoto) + 1)
      sNumFotoActual = Left(sNumFotoActual, Len(sNumFotoActual) - (Len(sExtensionFoto) + 1))
      
      If IsNumeric(sNumFotoActual) Then
        If CLng(sNumFotoActual) > CLng(sNumFotoMayor) Then sNumFotoMayor = sNumFotoActual
      End If
    
    End If

    sNombreFotoNueva = Dir
  
  Loop
  
  If sNumFotoMayor = "-1" Then Exit Sub
  
  sNombreFotoNueva = sPrefijoFoto + IIf(Len(sNumFotoMayor) < 3, LPad(sNumFotoMayor, 3, "0"), sNumFotoMayor) + "." + sExtensionFoto
  
  If Dir(sRutaFotosNuevas + sNombreFotoNueva) <> "" Then
  
    sRutaFotos = App.Path + IIf(Right(App.Path, 1) = "\", "", "\") + kDIR_FOTOS

    If Dir(sRutaFotos, vbDirectory) = "" Then
      MkDir (sRutaFotos)
    End If
  
    sNombreFoto = sPrefijoFoto + IIf(Len(sActualFoto) < 3, LPad(sActualFoto, 3, "0"), sActualFoto) + ".jpg"
    sFoto = sRutaFotos + sNombreFoto
    
    If Dir(sFoto) <> "" Then
      Kill sFoto
    End If
    
    MoveFile sRutaFotosNuevas + sNombreFotoNueva, sFoto
  
    If Dir(sFoto) <> "" Then
  
      Timer.Enabled = False
    
      sSQL = "UPDATE Configuracion SET nUFotNumb = $"
      sSQL = VBsprintf(sSQL, sActualFoto)
    
      If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then Exit Sub
    
      imgFoto.Picture = LoadPicture(sFoto)
      fraFoto.Caption = sNombreFoto
      CerrarAplicacion (sNombreVentana)
    
    End If
    
  End If
  
End Sub

Private Sub cmdEstandar_Click(Index As Integer)

  'Permite descargar el formulario, previamente haciendo cambios o no en
  'la tabla Cliente
  On Error GoTo LineaError

  Screen.MousePointer = vbHourglass

  Select Case Index

  Case kCMD_ACEPTAR

    If iEditar = kCMD_VER Then
      Unload Me
      GoTo Salir
    End If

    If ValidarData Then

      If ActualizarTabla Then
      
        ActualizarLista
        frmPrincipal.ManejarControles (False)
        
        Unload Me

      End If

    End If

  Case kCMD_CANCELAR
  
    'Si se modifico alguna tarjeta
    If bTarjetaFlag Then ActualizarLista

    Unload Me

  End Select

  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

Salir:
  Screen.MousePointer = vbDefault

End Sub

Private Function ValidarData() As Boolean

  'Valida que la información ingresada sea correcta y completa

  On Error GoTo LineaError

  ValidarData = False
  
  If iEditar = kCMD_NUEVO And Trim(txtTarjeta.Text) = "" Then
    MsgBox "Ingresar Nro. de Tarjeta", vbOKOnly + vbInformation
    txtTarjeta.SetFocus
    Exit Function
  End If
  
  txtTarjeta.Text = LPad(Trim(txtTarjeta.Text), 8, "0")

  If Trim(txtApellidos.Text) = "" Then
    MsgBox "Ingresar Apellidos", vbOKOnly + vbInformation
    txtApellidos.SetFocus
    Exit Function
  End If
  
  If Trim(txtNombres.Text) = "" Then
    MsgBox "Ingresar Nombres", vbOKOnly + vbInformation
    txtNombres.SetFocus
    Exit Function
  End If
  
  If Trim(dcbDepartamento.BoundText) = "" Then
    MsgBox "Seleccionar Departamento", vbOKOnly + vbInformation
    dcbDepartamento.SetFocus
    Exit Function
  End If
  
  If Trim(dcbProvincia.BoundText) = "" Then
    MsgBox "Seleccionar Provincia", vbOKOnly + vbInformation
    dcbProvincia.SetFocus
    Exit Function
  End If
  
  If Trim(dcbDistrito.BoundText) = "" Then
    MsgBox "Seleccionar Distrito", vbOKOnly + vbInformation
    dcbDistrito.SetFocus
    Exit Function
  End If
  
  If chkFNacimiento.Value = 1 And dtpFNacimiento > Date Then
    MsgBox "Fecha de Nacimiento no puede ser mayor al día de hoy", vbOKOnly + vbInformation
    dtpFNacimiento.SetFocus
    Exit Function
  End If

  ValidarData = True

  Exit Function

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Function

Private Function ActualizarTabla() As Boolean

  'Inserta/Actualiza/Elimina el registro de Cliente

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Dim bConnFlag As Boolean

  ActualizarTabla = False
  
  ADOCnn.BeginTrans
  bConnFlag = True

  Select Case iEditar

  Case kCMD_NUEVO
  
    sSQL = "SELECT * FROM Tarjeta WHERE TRIM(nTarjNumb) = TRIM('$')"
    sSQL = VBsprintf(sSQL, txtTarjeta.Text)
    
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo LineaError1
    
    If Not ADORS.EOF Then
      MsgBox "Nro. de Tarjeta ya se encuentra registrado en la Base de datos", vbOKOnly + vbInformation
      GoTo LineaError1
    End If
    
    Set ADORS = Nothing

    sSQL = "SELECT MAX(cClieCode) AS Codigo FROM Cliente"
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo LineaError1

    sCodigo = "1"

    If Not ADORS.EOF Then

      If LeerCampo(ADORS!Codigo) <> "" Then
        sCodigo = CStr(ADORS!Codigo + 1)
      End If

    End If

    Set ADORS = Nothing
    
    sSQL = "INSERT INTO Cliente (cClieCode, sClieApel, sClieName, sClieAddr, " + _
           "cDepaCode, cProvCode, cDistCode, sDepaDesc, sProvDesc, sDistDesc, " + _
           "sClieTelf, sClieMail, dNacmDate, dUltTDate, cTranCode, sClieRout) " + _
           "VALUES ($, '$', '$', '$', $, $, $, '$', '$','$', '$', '$', '$','$', " + _
           "$, '$')"
    sSQL = VBsprintf(sSQL, sCodigo, _
           ReemplazarComilla(Trim(txtApellidos.Text)), _
           ReemplazarComilla(Trim(txtNombres.Text)), _
           ReemplazarComilla(Trim(txtDireccion.Text)), _
           dcbDepartamento.BoundText, _
           dcbProvincia.BoundText, _
           dcbDistrito.BoundText, _
           IIf(dcbDepartamento.BoundText = kLOCALIDAD_OTROS, Trim(txtDepartamento.Text), ""), _
           IIf(dcbProvincia.BoundText = kLOCALIDAD_OTROS, Trim(txtProvincia.Text), ""), _
           IIf(dcbDistrito.BoundText = kLOCALIDAD_OTROS, Trim(txtDistrito.Text), ""), _
           ReemplazarComilla(Trim(txtTelefono.Text)), _
           ReemplazarComilla(Trim(txtEMail.Text)), _
           IIf(chkFNacimiento.Value = kSI, Format(dtpFNacimiento.Value, "yyyy/mm/dd"), Null), _
           Format(Date, "yyyy/mm/dd"), _
           kTRAN_AFILIACION, _
           sFoto)
           
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1
    
    sSQL = "INSERT INTO Tarjeta (cClieCode, nTarjNumb, cTarjActi, dEmisDate, sUserDesc) " + _
           "VALUES($, '$', $, '$', '$')"
    sSQL = VBsprintf(sSQL, sCodigo, Trim(txtTarjeta.Text), kSI, _
           Format(Date, "yyyy/mm/dd"), psUsuario_Descripcion)
    
  Case kCMD_EDITAR

    sSQL = "UPDATE Cliente SET sClieApel = '$', sClieName ='$', sClieAddr = '$', " + _
           "cDepaCode = $, cProvCode = $, cDistCode = $, sDepaDesc = '$', " + _
           "sProvDesc = '$', sDistDesc = '$', sClieTelf = '$' , sClieMail = '$', " + _
           "dNacmDate = '$', sClieRout = '$'" + _
           "WHERE cClieCode = $"
    sSQL = VBsprintf(sSQL, ReemplazarComilla(Trim(txtApellidos.Text)), _
           ReemplazarComilla(Trim(txtNombres.Text)), _
           ReemplazarComilla(Trim(txtDireccion.Text)), _
           dcbDepartamento.BoundText, _
           dcbProvincia.BoundText, _
           dcbDistrito.BoundText, _
           IIf(dcbDepartamento.BoundText = kLOCALIDAD_OTROS, Trim(txtDepartamento.Text), ""), _
           IIf(dcbProvincia.BoundText = kLOCALIDAD_OTROS, Trim(txtProvincia.Text), ""), _
           IIf(dcbDistrito.BoundText = kLOCALIDAD_OTROS, Trim(txtDistrito.Text), ""), _
           ReemplazarComilla(Trim(txtTelefono.Text)), _
           ReemplazarComilla(Trim(txtEMail.Text)), _
           IIf(chkFNacimiento.Value = kSI, Format(dtpFNacimiento.Value, "yyyy/mm/dd"), Null), _
           sFoto, _
           sCodigo)

  Case kCMD_BORRAR
  
    sSQL = "DELETE * FROM Tarjeta " + _
           "WHERE cClieCode = $"
    sSQL = VBsprintf(sSQL, sCodigo)
    
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then Exit Function

    sSQL = "DELETE * FROM Cliente " + _
           "WHERE cClieCode = $"
    sSQL = VBsprintf(sSQL, sCodigo)

  End Select

  If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then
    ADOCnn.CommitTrans
    bConnFlag = False
    ActualizarTabla = True
  Else
    GoTo LineaError1
  End If

  Exit Function

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
LineaError1:
  Set ADORS = Nothing
  If bConnFlag Then ADOCnn.RollbackTrans
  
End Function

Private Sub ActualizarLista()

  'Actualiza la lista de frmPrincipal

  On Error GoTo LineaError
  
  Dim itemX As ListItem
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Dim sTarjetaActiva As String
  Dim sTarjetaInactiva As String
  
  Dim sFecha As String
  
  Select Case iEditar
  
  Case kCMD_NUEVO, kCMD_EDITAR
  
    sTarjetaActiva = ""
    sTarjetaInactiva = ""
  
    If iEditar = kCMD_NUEVO Then
    
      Set itemX = frmPrincipal.lvwCliente.ListItems.Add(, "k" + sCodigo, Trim(txtApellidos.Text) + " " + Trim(txtNombres.Text))
      sTarjetaActiva = sTarjetaActiva + " - " + Trim(txtTarjeta.Text)
      
    Else
    
      sSQL = "SELECT nTarjNumb, cTarjActi " + _
             "FROM Tarjeta WHERE cClieCode = $ " + _
             "ORDER BY dEmisDate"
      sSQL = VBsprintf(sSQL, sCodigo)
    
      If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
      
      Do While Not ADORS.EOF
    
        If LeerCampo(ADORS!cTarjActi) = kSI Then
          sTarjetaActiva = sTarjetaActiva + " - " + LeerCampo(ADORS!nTarjNumb)
        Else
          sTarjetaInactiva = sTarjetaInactiva + " - " + LeerCampo(ADORS!nTarjNumb)
        End If
    
        ADORS.MoveNext
        
      Loop
      
      Set itemX = frmPrincipal.lvwCliente.SelectedItem
      itemX.Text = Trim(txtApellidos.Text) + " " + Trim(txtNombres.Text)
      
    End If
    
    itemX.SubItems(1) = IIf(chkFNacimiento.Value = kSI, Format(dtpFNacimiento.Value, "dd/mm/yyyy"), "")
    itemX.SubItems(2) = Mid(sTarjetaActiva, 4)
    itemX.SubItems(3) = Mid(sTarjetaInactiva, 4)
    
    If iEditar = kCMD_NUEVO Then
      itemX.SubItems(4) = "0"
      itemX.SubItems(5) = "0"
      itemX.SubItems(6) = Format(Date, "dd/mm/yyyy")
      itemX.SubItems(7) = TraerTransaccion(kTRAN_AFILIACION)
    End If
      
    itemX.Icon = 1
    itemX.SmallIcon = 1
    
    sFecha = CStr(Year(Date)) + Mid(Format(dtpFNacimiento.Value, "yyyy/mm/dd"), 5)
      
    If chkFNacimiento.Value = kSI And IsDate(sFecha) Then
      If CDate(sFecha) >= Date And CDate(sFecha) - Date <= 15 Then
        itemX.Icon = 2
        itemX.SmallIcon = 2
      End If
    End If
    
    itemX.Selected = True
    
  Case kCMD_BORRAR
  
    frmPrincipal.lvwCliente.ListItems.Remove (frmPrincipal.lvwCliente.SelectedItem.Index)
    
  End Select
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
  
End Sub

Private Function TraerTransaccion(sCodigo) As String

  'Trae Descripcion de la Transaccion

  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  TraerTransaccion = ""
  
  sSQL = "SELECT * FROM Transaccion WHERE cTranCode = $"
  sSQL = VBsprintf(sSQL, sCodigo)
  
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
  If Not ADORS.EOF Then
    TraerTransaccion = LeerCampo(ADORS!sTranDesc)
  End If
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing

End Function

Public Sub lvwTarjeta_Click()
  
  'Alimenta la caja de texto con el valor del item seleccionado
  
  On Error GoTo LineaError
  
  If lvwTarjeta.ListItems.Count > 0 Then
  
    If lvwTarjeta.SelectedItem.SmallIcon = 1 Then
      cmdActivar.Caption = "Desac&tivar"
    Else
      cmdActivar.Caption = "Ac&tivar"
    End If
    
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwTarjeta_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  'Ordena los registos según la columna seleccionada
  
  On Error GoTo LineaError
  
  If ColumnHeader.Index = 2 Then
    Call APISort(lvwTarjeta, ColumnHeader.Index, gbytLVW_SORT_DATE)
  Else
    Call APISort(lvwTarjeta, ColumnHeader.Index, gbytLVW_SORT_DEFAULT)
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub lvwTarjeta_DblClick()

  'Invoca al evento Click de cmdEditar
  
  On Error GoTo LineaError
  
  If lvwTarjeta.ListItems.Count > 0 Then
  
    If cmdEditar(kCMD_EDITAR).Enabled Then
      Call cmdEditar_Click(kCMD_EDITAR)
    Else
      Call cmdEditar_Click(kCMD_VER)
    End If
    
  End If

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

Private Sub lvwEstadistica_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  'Ordena los registos según la columna seleccionada
  
  On Error GoTo LineaError
  
  If ColumnHeader.Index <> 1 Then
    Call APISort(lvwTarjeta, ColumnHeader.Index, gbytLVW_SORT_VALUE)
  Else
    Call APISort(lvwTarjeta, ColumnHeader.Index, gbytLVW_SORT_DEFAULT)
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub


Private Sub cmdEditar_Click(Index As Integer)

  'Invoca al formulario Tarjeta
  
  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  frmTarjeta.iEditar = Index
  
  If iEditar = kCMD_EDITAR Then bTarjetaFlag = True
  
  If Index = kCMD_EDITAR Or Index = kCMD_BORRAR Then

    sSQL = "SELECT nTarjNumb FROM Acumulacion_Punto WHERE TRIM(nTarjNumb) = TRIM('$') UNION " + _
           "SELECT nTarjNumb FROM Acumulacion_Ticket WHERE TRIM(nTarjNumb) = TRIM('$') UNION " + _
           "SELECT nTarjNumb FROM Canje_Punto WHERE TRIM(nTarjNumb) = TRIM('$') UNION " + _
           "SELECT nTarjNumb FROM Canje_Ticket WHERE TRIM(nTarjNumb) = TRIM('$')"
    sSQL = VBsprintf(sSQL, lvwTarjeta.SelectedItem.Text, _
           lvwTarjeta.SelectedItem.Text, _
           lvwTarjeta.SelectedItem.Text, _
           lvwTarjeta.SelectedItem.Text)
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir

    If Not ADORS.EOF Then
      MsgBox "No se puede " + IIf(Index = kCMD_EDITAR, "editar", "borrar") + " la tarjeta. La tarjeta registra transacciones", vbOKOnly + vbInformation
      GoTo Salir
    End If
    
    Set ADORS = Nothing

  End If
    
  frmTarjeta.Show vbModal
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
  
End Sub

Private Sub cmdActivar_Click()

  'Activa o Desactiva a un Usuario

  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim sAccion As String
  Dim iActivo As Integer
  
  Dim bConnFlag As Boolean
  
  Screen.MousePointer = vbHourglass
  
  If lvwTarjeta.SelectedItem.SmallIcon = 1 Then
  
    sAccion = "desactivar"
    iActivo = kNO
    
  Else
  
    sAccion = "activar"
    iActivo = kSI
  
  End If
  
  If MsgBox("Se procederá a " + sAccion + " a la tarjeta Nro: " + lvwTarjeta.SelectedItem.Text + ". Desea continuar?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
  
    bTarjetaFlag = True
    
    ADOCnn.BeginTrans
    bConnFlag = True
  
    If iActivo = kSI Then
      
      sSQL = "UPDATE Tarjeta SET cTarjActi = $ WHERE cClieCode = $"
      sSQL = VBsprintf(sSQL, kNO, sCodigo)
    
      If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1
    
    End If
      
    sSQL = "UPDATE Tarjeta SET cTarjActi = $ WHERE TRIM(nTarjNumb) = TRIM('$')"
    sSQL = VBsprintf(sSQL, CStr(iActivo), lvwTarjeta.SelectedItem.Text)
    
    If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then
    
      ADOCnn.CommitTrans
      bConnFlag = False
    
      If iActivo = kSI Then
        
        lvwTarjeta.SelectedItem.Icon = 1
        lvwTarjeta.SelectedItem.SmallIcon = 1
        
        IconosDesactivados lvwTarjeta.SelectedItem.Text
        
      Else
        lvwTarjeta.SelectedItem.Icon = 2
        lvwTarjeta.SelectedItem.SmallIcon = 2
      End If
      
      Call lvwTarjeta_Click
      
    Else
      
        GoTo LineaError1
        
    End If
    
  End If

  Screen.MousePointer = vbDefault
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
    
LineaError1:
  If bConnFlag Then ADOCnn.RollbackTrans
  Screen.MousePointer = vbDefault

End Sub

Public Sub IconosDesactivados(sTarjeta As String)

  'Cambiar Icono de desactivado a todos los items de la lista menos al activo

  On Error GoTo LineaError
  
  Dim i As Integer
  Dim itemX As ListItem
  
  For i = 1 To lvwTarjeta.ListItems.Count
  
    Set itemX = lvwTarjeta.ListItems(i)
      
    If Trim(itemX.Text) <> Trim(sTarjeta) Then
      itemX.Icon = 2
      itemX.SmallIcon = 2
    End If
      
  Next

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

