'----****
'----**** 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
Relacionado