Excel VBA – Criar arquivo de texto delimitados

3
Criar arquivo de texto formatado Excel

Excel VBA – Criar arquivo de texto delimitados

Excel VBA - Criar arquivo texto delimitado

Este artigo apresenta uma planilha Excel VBA que realiza a exportação de um arquivo texto com os dados formatados e separados por delimitadores definidos enviada pelo meu amigo Jardel Novaes.

Jardel é analista de sistemas com ampla experiência em análise de sistemas e em diversas áreas de sistemas e já colaborou com outros artigos em nosso site. Obrigado por compartilhar o seu conhecimento.

Voltando ao assunto, a geração de arquivos texto é normalmente utilizada em várias situações nas empresas.

Pode ser para exportar uma base de dados para um cliente, ou ainda para gerar arquivos para importação em outros sistemas de terceiros.

O arquivo Excel é separado em duas planilhas, a de Dados e a de Layout e exportação.

Na planilha de Dados, temos os dados dispostos em colunas no formato de tabela, conforme segue o exemplo de dados abaixo:

Excel VBA - Criar arquivo texto delimitado

Esta tabela pode ser alterada conforme a sua necessidade, inclusive não precisando ser nem esta, dado que ela pode ser configurada na planilha de Layout.

O importante é que os dados devem estar dispostos em formato de lista e com um cabeçalho que indique o que deve ser digitado nesta coluna.

A planilha Layout possui os dados referentes ás configurações dos campos que deverão ser exportados e do arquivo que será criado.

Excel VBA - Criar arquivo texto delimitado

Agora veja como configurar os campos do arquivo a ser gerado:

Excel VBA - Criar arquivo texto delimitado

Na imagem acima preencha os campos conforme descrito nos comentários de cada coluna:

1. Campo: Cadastre aqui os campos que deseja ter no arquivo.

2. Tipo: Determine se o tipo de dado é um valor Fixo, A de Alfanumérico ou N de Numérico.

3. Tamanho: Determine o tamanho do campo.

4. Decimal: Defina a quantidade de casas decimais que o campo numérico possui.

5. Coluna: Determine a letra da coluna aonde estão os dados do campo.

Com os campos configurados para a geração definimos então os dados da geração do arquivo:

Excel VBA - Criar arquivo texto delimitado

1. Coluna: Defina o local do arquivo e o nome.

1. Substituir Arquivo?: Identifique se o arquivo que estiver salvo deve ser substituído.

3. Planilha de Dados: Defina o nome da planilha de origem dos dados, no caso do exemplo o seu nome é Dados.

4. Separador: Defina o delimitador a ser utilizado no arquivo.

Após a configuração dos dados para salvar o arquivo texto, clique no botão Gerar Arquivo, e aguarde a mensagem informando que o arquivo foi gerado com sucesso:

Excel VBA - Criar arquivo texto delimitado

O arquivo pode ser aberto na pasta informada:

Excel VBA - Criar arquivo texto delimitado

Abaixo o código fonte para a geração do arquivo texto, e mais abaixo o arquivo disponibilizado para download.

'----------------------------------------------------------------------------------------
'  Objetivo......: Geração de dados de uma planilha em arquivo texto
'  Criação.......: 02/07/2015
'  Autor.........: Jardel Novaes
'  Ult. Alteração:
'----------------------------------------------------------------------------------------
Option Explicit
Option Base 0
Option Compare Text
 
 
Const LAY_SRC As String = "LAYOUT"
 
Private FILE_PATH As String
Private FILE_OVERRIDE As Boolean
Private DATA_SRC As String
Private SEPARATOR As String
 
Private Configs As Collection
 
Public Sub GerarArquivoY570()
On Error GoTo ErrHwd
    Dim lastRow As Long, i As Long
    Dim line As String
 
    LoadConfigs
 
    Worksheets(DATA_SRC).Select
    Worksheets(DATA_SRC).Range("A1").Select
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        line = line & getFormatedLine(i) & vbCrLf
    Next
    SaveFile line
    MsgBox "Arquivo gerado com sucesso em: " & vbCrLf & FILE_PATH, vbInformation
ErrHwd:
    If Err Then
        MsgBox "Ocorreu um erro (" & Err.Number & ")" & vbCrLf & Err.Description, vbCritical
    End If
End Sub
 
Private Function getFormatedLine(ByVal lineIdx As Long) As String
On Error GoTo ErrHwd
    Dim lastRow As Long, i As Long
    Dim Ret As String, Aux As String, fmt As String
 
    Ret = ""
    For i = 1 To Configs.Count
        If Configs(i)(1) = "FIXO" Then
            Ret = Ret & Configs(i)(4) & SEPARATOR
            GoTo Continue
        End If
 
        'retira eventuais pipes no conteúdo.
        Aux = Replace(Trim(Worksheets(DATA_SRC).Range(Configs(i)(4) & lineIdx).Value), SEPARATOR, " ")
 
        'If Aux = "NÃO" Then Aux = "N"
        'If Aux = "SIM" Then Aux = "S"
 
        If Configs(i)(1) = "N" Then
            fmt = String(Configs(i)(2), "0")
            If "0" & Configs(i)(3) > 0 Then
                fmt = fmt & "." & String("0" & Configs(i)(3), "0")
            End If
            'caso de S.O. em inglês garante a virgula no lugar de ponto.
            Aux = Replace(Format(Aux, fmt), ".", ",")
        Else
            Aux = Left(Aux, "0" & Configs(i)(2))
        End If
        Ret = Ret & Aux & SEPARATOR
Continue:
    Next
    getFormatedLine = Ret
ErrHwd:
    If Err Then
        MsgBox "Ocorreu um erro não esperado." & vbCrLf & Err.Number & "-" & Err.Description, vbCritical
    End If
End Function
 
Private Sub LoadConfigs()
On Error GoTo ErrHwd
    Dim lastRow As Long, i As Long, j As Long
    Dim lRet As String
    Dim item() As String
 
    Worksheets(LAY_SRC).Select
    Worksheets(LAY_SRC).Range("A1").Select
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
 
    FILE_PATH = Worksheets(LAY_SRC).Range("H2").Value
    FILE_OVERRIDE = Worksheets(LAY_SRC).Range("I2").Value = "Sim"
    DATA_SRC = Worksheets(LAY_SRC).Range("J2").Value
    SEPARATOR = Worksheets(LAY_SRC).Range("K2").Value
 
    Set Configs = Nothing
    Set Configs = New Collection
 
    For i = 2 To lastRow
        'limpar o array
        ReDim item(4)
        For j = 1 To 5
            item(j - 1) = Cells(i, j).Value
        Next
        Configs.Add item, Cells(i, 1).Value
    Next
ErrHwd:
    If Err Then
        Err.Raise vbObjectError + 1000, "LoadConfigs", "Ocorreu um erro ao carregar as configurações de layout." & vbCrLf & Err.Description
    End If
    'Tenta acessar a sheet de dados se der erro mostra mensagem amigável
    On Error Resume Next
    lRet = Application.Worksheets(DATA_SRC).Range("A1").Value
    If Err Then
        On Error GoTo 0
        Err.Raise vbObjectError + 4000, "LoadConfigs", "A planilha de dados que foi informada não existe." & vbCrLf & "Valor informado: """ & DATA_SRC & """" & vbCrLf & Err.Description
    End If
End Sub
 
 
Private Sub SaveFile(ByVal text As String)
On Error GoTo ErrHwd
    Dim fNum As Long
    Dim errMsg As String
    fNum = FreeFile
 
    If Not FILE_OVERRIDE Then
        If Dir(FILE_PATH, vbArchive) <> "" Then
            On Error GoTo 0
            Err.Raise vbObjectError + 2000, "SaveFile", "O processo está configurado para NÃO substituir o arquivo e um arquivo com esse nome e caminho já existe!" & vbCrLf & "O processo será abortado, revise as configurações e tente novamente." & vbCrLf & vbCrLf & "Nome do arquivo: " & FILE_PATH
        End If
    End If
 
    Open FILE_PATH For Output As #fNum
    Print #fNum, text
    Close (fNum)
ErrHwd:
    If Err Then
        errMsg = "Ocorreu um erro ao salvar o arquivo." & vbCrLf & Err.Description & vbCrLf & vbCrLf & "Nome do arquivo: " & FILE_PATH
        On Error Resume Next
        Close (fNum)
        On Error GoTo 0
        Err.Raise vbObjectError + 3000, "SaveFile", errMsg
    End If
 
 
End Sub

Excel VBA - Criar arquivo texto delimitado

Abraço

Marcos Rieper

3 COMENTÁRIOS

  1. Não estou conseguindo identificar onde vc faz referencia entre a coluna 5 da planilha layout e os dados da planilha de dados. gostaria de incluir mais uma coluna nas config. do layout com a quantidade de espaços apos a informação. se puder informar agradeço.

DEIXE UMA RESPOSTA

Please enter your comment!
Please enter your name here