Publicado el Dejar un comentario

BITACORA003 Genera el archivo de bitacora

'----**** 
'----**** MyBusiness POS V20
'----**** Version del script: 1.0
'----**** 19/02/2020
'----**** 
Public Sub Main()

    if ListView1(0).SelectedItem Is Nothing Then
       MsgBox "Debe de seleccionar primero una bitacora", vbInformation
       Exit Sub
    End if

    Set Files = NewCollection

    Set rstHistcamb = CreaRecordSet( "SELECT histcamb.*, prods.descrip, prods.granel, prods.impuesto, prods.bajocosto, prods.bloqueado FROM histcamb INNER JOIN prods USING( articulo ) WHERE histcamb.bitacora = " & Mid(ListView1(0).SelectedItem.Key, 2), Ambiente.Connection )
    cArchivo = Ambiente.Path & "\Prods" & ".xml"
    EliminaArchivo cArchivo
    rstHistcamb.Save cArchivo, 1
    Files.Add cArchivo


    Set rstHistcamb = CreaRecordSet( "SELECT clavesadd.* FROM clavesadd INNER JOIN histcamb USING( articulo ) WHERE histcamb.bitacora = " & Mid(ListView1(0).SelectedItem.Key, 2), Ambiente.Connection )
    cArchivo = Ambiente.Path & "\Clavesadd" & ".xml"
    EliminaArchivo cArchivo
    rstHistcamb.Save cArchivo, 1
    Files.Add cArchivo
        
    Ambiente.Connection.Execute "UPDATE bitacora SET exportado = 1 WHERE id = " & Mid(ListView1(0).SelectedItem.Key, 2)

    cArchivo = ArielBrowseFolder1 & "\Bitacora" & Mid(ListView1(0).SelectedItem.Key, 2) &  ".zip"

    RichsoftVBZip1.FileName = cArchivo

    if ExisteArchivo( cArchivo ) Then
       if Question( "La bitacora ya existe desea sobreescibirlo" ) Then
          EliminaArchivo cArchivo
       else
          Exit Sub
       end if
    end if

    RichsoftVBZip1.Add (Files), 1, False, False, False, 5

    MsgBox "Archivo : " & cArchivo & " fue creado",  vbInformation    
   
End Sub
Deja un comentario