Função para copiar registro de uma filial para outra

Olá pessoal…

Hoje vou mostrar uma função desenvolvida para cópia de registros de uma filial para outra (com opção de mudança de código).

Essa rotina, o ideal é primeiramente utilizar em base de testes, ela faz uma consulta SQL buscando o registro de origem e através desse registro cria um de destino, seja mudando a filial e/ou mudando o código.

Ao abrir a rotina é mostrado a tela de Pergunte.

Tela de parâmetros para cópia de registro

Tela de parâmetros para cópia de registro

Onde os parâmetros são:
Tabela: Alias da tabela (por exemplo, SB1)
Campo Chave: Campo chave da tabela (por exemplo, B1_COD)
Filial Atual: Filial do registro que existe (por exemplo, 01)
Chave Atual: Código do registro do campo chave (por exemplo, 000001)
Filial Nova: Filial do novo registro (por exemplo, 02)
Chave Nova: Novo código do registro (por exemplo, 000099)

Abaixo o código fonte desenvolvido.

//Bibliotecas
#Include "Protheus.ch"
#Include "TopConn.ch"

/*/{Protheus.doc} zCpyReg
Função para copiar registros entre as filiais
@type function
@author Atilio
@since 02/01/2017
@version 1.0
	@example
	u_zCpyReg()
/*/

User Function zCpyReg()
	Local aArea        := GetArea()
	Local cPerg        := "X_zCpyReg"
	Private cTabelaAux := ""
	Private cChaveAux  := ""
	Private cFilAtuAux := ""
	Private cCodAtuAux := ""
	Private cFilNovAux := ""
	Private cCodNovAux := ""
	
	//Cria o grupo de pergunta
	fVldPerg(cPerg)
	
	//Se a pergunta for confirmada
	If Pergunte(cPerg, .T.)
		cTabelaAux := MV_PAR01
		cChaveAux  := MV_PAR02
		cFilAtuAux := MV_PAR03
		cCodAtuAux := MV_PAR04
		cFilNovAux := MV_PAR05
		cCodNovAux := MV_PAR06
		
		//Se tiver algum parâmetro em branco, encerra
		If 	Empty(cTabelaAux) .Or.;
			Empty(cChaveAux) .Or.;
			Empty(cCodAtuAux) .Or.;
			Empty(cCodNovAux)
			MsgAlert("Existe(m) parâmetros em branco!", "Atenção")
		EndIf
		
		Processa({|| fCopia()},'Processando')
	EndIf
	
	RestArea(aArea)
Return

/*---------------------------------------------------------------------*
 | Func:  fCopia                                                       |
 | Autor: Daniel Atilio                                                |
 | Data:  02/01/2017                                                   |
 | Desc:  Função para copiar os dados                                  |
 *---------------------------------------------------------------------*/

Static Function fCopia()
	Local aArea     := GetArea()
	Local aEstru    := {}
	Local aConteu   := {}
	Local nPosFil   := 0
	Local cCampoFil := ""
	Local cQryAux   := ""
	Local nAtual    := 0
	
	DbSelectArea(cTabelaAux)
	
	//Pega a estrutura da tabela
	aEstru := (cTabelaAux)->(DbStruct())
	
	//Encontra o campo filial
	nPosFil   := aScan(aEstru, {|x| "FILIAL" $ AllTrim(Upper(x[1]))})
	cCampoFil := aEstru[nPosFil][1]
	
	//Faz uma consulta sql trazendo o RECNO
	cQryAux := " SELECT "
	cQryAux += " 	R_E_C_N_O_ AS DADREC "
	cQryAux += " FROM "
	cQryAux += " 	"+RetSQLName(cTabelaAux)+" "
	cQryAux += " WHERE "
	cQryAux += " 	"+cCampoFil+" = '"+cFilAtuAux+"' "
	cQryAux += " 	AND "+cChaveAux+" = '"+cCodAtuAux+"' "
	cQryAux += " 	AND D_E_L_E_T_ = ' ' "
	TCQuery cQryAux New Alias "QRY_AUX"
	
	//Caso exista registro
	If ! QRY_AUX->(EoF())
		//Posiciona nesse recno
		(cTabelaAux)->(DbGoTo(QRY_AUX->DADREC))
		
		//Percorre a estrutura
		ProcRegua(Len(aEstru))
		For nAtual := 1 To Len(aEstru)
			IncProc("Adicionando valores ("+cValToChar(nAtual)+" de "+cValToChar(Len(aEstru))+")...")
			
			//Se for campo filial
			If Alltrim(aEstru[nAtual][1]) == Alltrim(cCampoFil)
				aAdd(aConteu, cFilNovAux)
				
			//Se for o campo de código
			ElseIf Alltrim(aEstru[nAtual][1]) == Alltrim(cChaveAux)
				aAdd(aConteu, cCodNovAux)
				
			//Se não, adiciona
			Else
				aAdd(aConteu, &(cTabelaAux+"->"+aEstru[nAtual][1]))
			EndIf
		Next
		
		IncProc("Criando o registro...")
		//Faz um RecLock
		RecLock(cTabelaAux, .T.)
			//Percorre a estrutura
			For nAtual := 1 To Len(aEstru)
				//Grava o novo valor
				&(aEstru[nAtual][1]) := aConteu[nAtual]
			Next
		(cTabelaAux)->(MsUnlock())
		
		MsgInfo("Cópia concluída.", "Atenção")
	EndIf
	QRY_AUX->(DbCloseArea())
	
	RestArea(aArea)
Return

/*---------------------------------------------------------------------*
 | Func:  fVldPerg                                                     |
 | Autor: Daniel Atilio                                                |
 | Data:  02/01/2016                                                   |
 | Desc:  Função para criar o grupo de perguntas                       |
 *---------------------------------------------------------------------*/

Static Function fVldPerg(cPerg)
	//(		cGrupo,	cOrdem,	cPergunt,				cPergSpa,		cPergEng,	cVar,		cTipo,	nTamanho,					nDecimal,	nPreSel,	cGSC,	cValid,	cF3,		cGrpSXG,	cPyme,	cVar01,		cDef01,	cDefSpa1,	cDefEng1,	cCnt01,	cDef02,		cDefSpa2,	cDefEng2,	cDef03,			cDefSpa3,		cDefEng3,	cDef04,	cDefSpa4,	cDefEng4,	cDef05,	cDefSpa5,	cDefEng5,	aHelpPor,	aHelpEng,	aHelpSpa,	cHelp)
	PutSx1(cPerg,		"01",		"Tabela?",				"",				"",			"mv_ch0",	"C",	03,							0,			0,			"G",	"", 		"SX2PAD",	"",			"",		"mv_par01",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
	PutSx1(cPerg,		"02",		"Campo Chave?",		"",				"",			"mv_ch1",	"C",	10,							0,			0,			"G",	"", 		"",			"",			"",		"mv_par02",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
	PutSx1(cPerg,		"03",		"Filial Atual?",		"",				"",			"mv_ch2",	"C",	FWSizeFilial(),			0,			0,			"G",	"", 		"SM0",		"",			"",		"mv_par03",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
	PutSx1(cPerg,		"04",		"Chave Atual?",		"",				"",			"mv_ch3",	"C",	30,							0,			0,			"G",	"", 		"",			"",			"",		"mv_par04",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
	PutSx1(cPerg,		"05",		"Filial Nova?",		"",				"",			"mv_ch4",	"C",	FWSizeFilial(),			0,			0,			"G",	"", 		"SM0",		"",			"",		"mv_par05",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
	PutSx1(cPerg,		"06",		"Chave Nova?",		"",				"",			"mv_ch5",	"C",	30,							0,			0,			"G",	"", 		"",			"",			"",		"mv_par06",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
Return

Bom pessoal, por hoje é só.
Abraços e até a próxima.

Dan Atilio (Daniel Atilio)
Especialista em Engenharia de Software pela FIB. Entusiasta de soluções Open Source. E blogueiro nas horas vagas.

12 Responses

  1. CLEBERSON DA SILVA disse:

    Bom dia, Danilo

    Será que nesta função seria possível copiar todos os registros de determinado produto, pelo que entendi ele a função vai copiando por campo

  2. CLEBERSON DA SILVA disse:

    DANIEL

    Qual o nome da função estou tentando colocar ela no menu mas não esta dando certo

    • Dan_Atilio disse:

      Bom dia Cleberson.
      A função é a zCpyReg, porém como ela é de 2017, a função PutSX1 para criar grupo de perguntas já foi descontinuada, então você terá que criar um grupo de perguntas conforme a função fVldPerg.
      Um grande abraço.

      • CLEBERSON DA SILVA disse:

        Bom dia, Danilo

        Crie o grupo de perguntas conforme a função fVldPerg

        Exemplo: Foi feito direto no grupo de perguntas no configurador
        Nome do Grupo: zCpyReg
        Tabela: Consulta Padrão SX2

        Feito isto apresenta a mensagem
        “Não Existe informações para Consulta

        • Dan_Atilio disse:

          Bom dia Cleberson, tudo bem?
          Entendi, no fonte é utilizado a consulta SX2PAD ao invés de SX2.
          Tente alterar e fazer o teste novamente.
          Abraços.

        • CLEBERSON DA SILVA disse:

          Bom dia,

          Alterei tanto no fonte quanto nas perguntas e não funcionou.

        • CLEBERSON DA SILVA disse:

          Daniel,

          Mesmo colocando somente uma pergunta exemplo de filial SM0 não apresenta então acredito que deva ser outra coisa.

        • Dan_Atilio disse:

          Cleberson, você criou a pergunta com o código X_zCpyReg, e na consulta padrão ao invés de “SX2” colocou “SX2PAD” e continuou o problema?
          Se sim, por favor, entre em contato no grupo do Discord (o link está no cabeçalho perto dos links do youtube e twitter), que lá podemos te orientar melhor, e você consegue mandar os prints dos erros.
          Abraços.

        • CLEBERSON DA SILVA disse:

          Na pergunta foi criado com o código “zCpyReg” porque se informar X_zCpyReg esta apresentando a critica ONLYALPHA

  3. Renato Gomes disse:

    Muito bacana. Achei este post buscando uma solução para transferir pedido de vendas de uma filial para a outra. Você teria alguma dica? esta função atenderia essa minha necessidade? Desde já agradeço demais pelo conhecimento compartilhado, seus posts são de muita ajuda para iniciantes como eu.

    • Dan_Atilio disse:

      Olha, essa é uma função de testes, e o ideal é cópia de tabelas customizadas ou simples.
      Para pedido de venda, envolve atualização de várias outras tabelas, como última compra de cliente, se for liberado, saldos dos produtos e liberações.
      Se quiser arriscar, você pode tentar fazer com SC5, SC6, SC9, etc…
      Mas eu indicaria, se for copiar um pedido de uma filial para outra, utilizar ExecAuto copiando os dados.

Deixe uma resposta