VBA/VB6 Status transfer of a current account document

Question

I am developing a routine to allow you to change status of a shopping document, existing in Pending, for example from Pending to Unapproved state.

The code:

Function CriaDocumentoMudancaEstadoPRI(TipoDocTrans As String,strNovoEstado as String, Modulo As String, TipoDoc As String, NumDocInt As Long, Serie As String, strTipoEntidade As String, strEntidade As String) As Boolean

Dim msg As String
Dim objPen As GCPBE900.GcpBEPendente
Dim objDocTrans As New GCPBE900.GcpBEDocumentoTransf

Dim objLinhasTransO As New GCPBE900.GcpBELinhaTransf
Dim objLinhasTransD As New GCPBE900.GcpBELinhaTransf

Dim rs As Object
Dim IDTransf  As String

    Set rs = MotorERP.Consulta("SELECT NewID() ID")
    IDTransf = rs!ID
    Set rs = Nothing


    If MotorERP.Comercial.Pendentes.Existe("000", Modulo, TipoDoc, Serie, NumDocInt) Then
      Set objPen = MotorERP.Comercial.Pendentes.Edita("000", "C", TipoDoc, Serie, NumDocInt)

      '-----------------------------------------
      '1- preenche o cabecalho do documento
      '-----------------------------------------
      With objDocTrans

        .TipoDoc = TipoDocLiq
        .Filial = objPen.Filial
        .Serie = objPen.Serie
        .TipoEntidade = strTipoEntidade
        .Entidade = strEntidade
        .TipoLancamento = objPen.TipoLancamento

        .Moeda = objPen.Moeda
        .MoedaDaUEM = objPen.MoedaDaUEM
        .Cambio = objPen.Cambio
        .CambioMAlt = objPen.CambioMAlt
        .CambioMBase = objPen.CambioMBase

        .DataDoc = objPen.DataDoc
        .Observacoes = objPen.Observacoes
        .ModoPag = ""
        .ContaBancaria = ""
        .EstadoDestino = strNovoEstado
        .TotalDoc = objPen.ValorPendente
        .Utilizador = strUsername
        .ModoPag = ""

        .ID = IDTransf
        .TipoConta = "C"
        .DataDoc = Date
        .Modulo = objPen.Modulo
        .TipoContaDestino = objPen.TipoConta
        .TransferenciaEstado = True
        .Modulo = "M"
        .EntidadeDestino = .Entidade

      End With

      '2- adiciona linha com estado atual
      Set objLinhasTransO = CreateObject("GcpBE900.GcpBELinhaTransf")
      With objLinhasTransO
            .TipoDocOrig = objPen.TipoDoc
            .NumDocOrig = objPen.NumDoc
            .NumDocOrigInt = objPen.NumDocInt
            .ModoPag = objPen.Modulo
            .MoedaDocOrig = objPen.Moeda
            .MoedaDaUEMDocOrig = False
            .CambioDocOrig = objPen.Cambio
            .CambioMAltDocOrig = objPen.CambioMAlt
            .CambioMBaseDocOrig = objPen.CambioMBase
            If .CambioMBaseDocOrig = 0 Then .CambioMBaseDocOrig = 1
            .FilialOrig = objPen.Filial
            .ModuloOrig = objPen.Modulo
            .ValorOrig = -Valor
            .ValorRec = -Valor
            .SerieOrig = objPen.Serie
            .Estado = objPen.Estado
            .FilialOrig = "000"
            .ModuloOrig = "C"
            .NumDocOrigInt = objPen.NumDocInt
            .NumDocOrig = objPen.NumDoc
            .PendenteGerado = False
            .SerieOrig = objPen.Serie
            .TipoConta = objPen.TipoConta
            If .CambioDocOrig = 0 Then .CambioDocOrig = 1
            If .CambioMAltDocOrig = 0 Then .CambioMAltDocOrig = 1
            If .CambioMBaseDocOrig = 0 Then .CambioMBaseDocOrig = 1

            .TipoConta = objPen.TipoConta
            .Estado = objPen.Estado

            .TipoEntidadeOrigem = "F"
            .TipoEntidadeComercial = ""
            .EntidadeComercial = ""
            .EntidadeOrigem = objPen.Entidade

            .FilialOrig = "000"
            .ModuloOrig = "C"
            .TipoDocOrig = objPen.TipoDoc
            .TransfereEntidade = False

            .IdHistorico = objPen.IdHistorico
            .ModoPag = ""
            .NumPrestacaoOrig = objPen.NumPrestacao
            .IDDocTransf = IDTransf
      End With

      Set objLinhasTransD = CreateObject("GcpBE900.GcpBELinhaTransf")
      With objLinhasTransD
            .TipoDocOrig = objPen.TipoDoc
            .NumDocOrig = objPen.NumDoc
            .NumDocOrigInt = objPen.NumDocInt
            .ModoPag = objPen.Modulo
            .MoedaDocOrig = objPen.Moeda
            .MoedaDaUEMDocOrig = False
            .CambioDocOrig = objPen.Cambio
            .CambioMAltDocOrig = objPen.CambioMAlt
            .CambioMBaseDocOrig = objPen.CambioMBase
            If .CambioMBaseDocOrig = 0 Then .CambioMBaseDocOrig = 1
            .FilialOrig = objPen.Filial
            .ModuloOrig = objPen.Modulo
            .ValorOrig = -Valor
            .ValorRec = 0
            .SerieOrig = objPen.Serie
            '-----------------------------------
            ' Define novo estado do documento
            '-----------------------------------
            .Estado = strNovoEstado
            .FilialOrig = "000"

            .ModuloOrig = "C"

            .NumDocOrigInt = objPen.NumDocInt
            .NumDocOrig = objPen.NumDoc
            .PendenteGerado = False
            .SerieOrig = objPen.Serie
            .TipoConta = objPen.TipoConta
            If .CambioDocOrig = 0 Then .CambioDocOrig = 1
            If .CambioMAltDocOrig = 0 Then .CambioMAltDocOrig = 1
            If .CambioMBaseDocOrig = 0 Then .CambioMBaseDocOrig = 1
            .TipoConta = objPen.TipoConta
            .TipoEntidadeOrigem = "F"
            .TipoEntidadeComercial = ""
            .EntidadeComercial = ""
            .EntidadeOrigem = objPen.Entidade

            .FilialOrig = "000"
            .ModuloOrig = "C"
            .TipoDocOrig = objPen.TipoDoc
            .TransfereEntidade = False
            .NumPrestacaoOrig = objPen.NumPrestacao

            .IdHistorico = objPen.IdHistorico
            .IDDocTransf = IDTransf
      End With



      objLinhasTransD.Estado = strNovoEstado



      objDocTrans.DocumentosTransferir.Insere objLinhasTransO
      objDocTrans.DocumentosTransferir.Insere objLinhasTransD


      objDocTrans.TipoEntidadeDestino = "F"

      objDocTrans.TotalDoc = objPen.ValorPendente

      Dim strErros As String

      If MotorERP.Comercial.Transferencias.ValidaActualizacao(objDocTrans, strErros) Then

        MotorERP.Comercial.Transferencias.Actualiza objDocTrans, strErros
        CriaDocumentoMudancaEstado = True

      Else
        CriaDocumentoMudancaEstado = False

      End If

    Else
      MsgBox "Nao existe pendente", vbExclamation
    End If


End Function

Example of its use:

Childdocumentingstatechange "NAP", "C", "VFA", 1, "2019", "F", "F00111"

I get the error:

The NAP Document - has no correct data for the transfer, a Destination Entity the Destination Account and the Destination State are the same as yours Origins Line2 : No Pending Reference for Document 000 A VF1 999285/A The value transferred from the original VF1 document 999285/A cannot be null. You cannot perform state transfers together with transfers of other types.

What will be missing in the code?

Answer 1

Good afternoon,

In the document header missing enable the property Maintainability:

objDocTrans.MantemEntidadePendentes = True

In the case of lines, the correct shape is using the Add line method:

Set objDocTrans = BSO.Comercial.Transferencias.AdicionaLinha(objDocTrans, objPen.Filial, objPen.Modulo, objPen.TipoDoc, objPen.Serie, objPen.NumDocInt, objPen.NumPrestacao, objPen.Estado, objPen.NumTransferencia)

After this Addirow you still have to assign these properties:

objDocTrans.DocumentosTransferir(1).ValorOrig = objPen.ValorPendente * -1
objDocTrans.DocumentosTransferir(1).ValorRec = objPen.ValorPendente * -1
objDocTrans.DocumentosTransferir(1).IdHistorico = objPen.IdHistorico