No artigo de hoje, vamos demonstrar uma função, onde é possível exportar o resultado de uma query para um arquivo txt.

No passado, já haviamos feito isso para Excel ( nesse link – https://terminaldeinformacao.com/2017/10/03/funcao-gera-arquivo-excel-atraves-de-uma-query-sql/ ). A ideia, seria ao informar uma query, a customização montar sozinha já um arquivo TXT com o resultado.

A lógica então da rotina é a seguinte:

1. É recebido em um parâmetro a query que será executada
2. Essa query vai ser executada com PLSQuery
3. Nisso através do DbStruct, vai ser avaliado quais são as colunas e os tamanhos delas, para definir a estrutura do TXT
4. Será então feito um laço de repetição nos dados, e adicionado nesse arquivo texto
5. Por fim, será aberto o arquivo TXT

O nome da customização é zQry2Txt, abaixo uma forma de acionar ela, buscando informações do cadastro de produtos:

u_zQry2Txt("SELECT B1_COD, B1_DESC FROM SB1990 SB1 WHERE B1_FILIAL = '' AND D_E_L_E_T_ = ' '", .T.)

Abaixo um print do resultado:

Resultado da query em TXT

E abaixo o código fonte da zQry2Txt:

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

/*/{Protheus.doc} User Function zQry2Txt
Executa uma query e gera num arquivo TXT
@type  Function
@author Atilio
@since 20/12/2023
@example u_zQry2Txt("SELECT TOP 10 B1_COD, B1_DESC FROM " + RetSQLName("SB1"), .T.)
/*/

User Function zQry2Txt(cQryAux, lAbreArq)
    Local aArea := FWGetArea()
    Default lAbreArq := .F.
    Private oProcess
    Private lSemTela := IsBlind()
    Private cNomeArq := ""
    Private lVaiAbrir := lAbreArq
    
    //Somente se veio query
    If ! Empty(cQryAux)

        //Aciona o processamento
        If lSemTela
            fProcessa(cQryAux)
        Else
            oProcess := MsNewProcess():New({|| fProcessa(cQryAux) }, "Processando...", "Aguarde...", .T.)
            oProcess:Activate()
        EndIf
    EndIf

    FWRestArea(aArea)
Return cNomeArq

Static Function fProcessa(cQryAux)
	Local aArea       := GetArea()
    Local oFWriter
    Local cPasta      := Iif(lSemTela, "\x_temp\", GetTempPath() + "files\")
    Local cArquivo    := "zqry2txt_" + dToS(Date()) + "_" + StrTran(Time(), ":", "-") + ".txt"
    Local nColuna     := 0

	//Executa a query
    PLSQuery(cQryAux, "QRY_AUX")
    If ! QRY_AUX->(EoF())
        //Se a pasta não existir, cria
        If ! ExistDir(cPasta)
            MakeDir(cPasta)
        EndIf

        //Pega os campos
        aEstrut := QRY_AUX->(DbStruct())

        //Cria o arquivo
        oFWriter := FWFileWriter():New(cPasta + cArquivo, .T.)
      
        //Se houve falha ao criar, mostra a mensagem
        If ! oFWriter:Create()
            FWAlertError("Falha o criar o arquivo " + cPasta + cArquivo)
        Else

            //Linha 1 que é o cabeçalho das colunas
            cLinha := ""
            For nColuna := 1 To Len(aEstrut)
                cCampo   := aEstrut[nColuna][1]
                cTipo    := aEstrut[nColuna][2]
                nTamanho := aEstrut[nColuna][3]

                //Se for Data, aumenta de 8 para 10 (DD/MM/YYYY)
                If cTipo == "D"
                    nTamanho := 10
                EndIf

                //Se tiver underline, busca o nome do campo direto na SX3
                If "_" $ cCampo
                    cTitulo := RetTitle(cCampo)
                    If ! Empty(cTitulo)
                        cCampo := cTitulo
                    EndIf
                EndIf

                //Se o tamanho for menor que 10, define um tamanho minimo
                If nTamanho < 10
                    nTamanho := 10
                EndIf
                
                cLinha += PadR(Capital(cCampo), nTamanho) + "|"
            Next
            cLinha += CRLF
            oFWriter:Write(cLinha)

            //Linha 2 que é de separação
            cLinha := ""
            For nColuna := 1 To Len(aEstrut)
                cCampo   := aEstrut[nColuna][1]
                cTipo    := aEstrut[nColuna][2]
                nTamanho := aEstrut[nColuna][3]

                //Se o tamanho for menor que 10, define um tamanho minimo
                If nTamanho < 10
                    nTamanho := 10
                EndIf

                cLinha += Replicate("-", nTamanho) + "*"
            Next
            cLinha += CRLF
            oFWriter:Write(cLinha)

            //Definindo o total da barra
            DbSelectArea("QRY_AUX")
            QRY_AUX->(DbGoTop())
            Count To nTotal
            u_zProcRegua(oProcess, nTotal, 5)
            nAtual := 0

            //Agora da linha 3 em diante busca os dados da query
            QRY_AUX->(DbGoTop())
            While !QRY_AUX->(EoF())
                nAtual++
                u_zIncProc(oProcess, "Processando registro...")

                //Monta a linha
                cLinha := ""
                For nColuna := 1 To Len(aEstrut)
                    cCampo    := aEstrut[nColuna][1]
                    cTipo     := aEstrut[nColuna][2]
                    nTamanho  := aEstrut[nColuna][3]

                    //Se o tamanho for menor que 10, define um tamanho minimo
                    If nTamanho < 10
                        nTamanho := 10
                    EndIf

                    //Formata o campo
                    xConteudo := &("QRY_AUX->" + cCampo)
                    If cTipo $ "N;L;"
                        xConteudo := PadR(cValToChar(xConteudo), nTamanho)
                    ElseIf cTipo == "D"
                        xConteudo := dToC(xConteudo)
                    Else
                        xConteudo := PadR(xConteudo, nTamanho)
                    EndIf

                    cLinha += xConteudo + "|"
                Next
                cLinha += CRLF
                oFWriter:Write(cLinha)

                QRY_AUX->(DbSkip())
            EndDo

        EndIf
        oFWriter:Close()
        cNomeArq := cPasta + cArquivo

        //Abre o arquivo
        If ! lSemTela .And. File(cPasta + cArquivo) .And. lVaiAbrir
            ShellExecute("OPEN", cArquivo, "", cPasta, 1)
        EndIf
    EndIf
    QRY_AUX->(DbCloseArea())
	

	RestArea(aArea)
Return

Bom pessoal, por hoje é só.

Abraços e até a próxima.

Tags: AdvPLProtheus