Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Exportar para XML apenas as células preenchidas

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
lboff
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Sex Mar 15, 2019 11:36 pm

Exportar para XML apenas as células preenchidas

Mensagem por lboff »

Boa noite,

Utilizo uma Macro VBA para gerar um arquivo XML para cada linha do excel.
Porém, preciso que para células que estão vazias, a Macro VBA desconsidere e não inclua no arquivo.
Segue abaixo.

Código: Selecionar todos

Sub ExportToXml()

      
    Dim linha As Long, coluna As Long, colunas As Long
    linha = 2
    colunas = ActiveSheet.UsedRange.Columns.Count
    
    
    With ActiveSheet
        Do While Not IsEmpty(.Cells(linha, 1))
        
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    
            
    Set a = fs.CreateTextFile(Cells(linha, 1).Value & ".xml", True)
    
    
    'cria as primeiras linhas
    a.WriteLine ("<?xml file>")
    a.WriteLine ("<IncluirRelatorioFinanceiro>")
         
        coluna = 1
        a.Write (Chr(9) & _
        "<NumeroDocumento>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</NumeroDocumento>" & Chr(13))
            
        a.WriteLine
        coluna = 2
        a.Write (Chr(9) & _
        "<NomeTomadorServico>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</NomeTomadorServico>" & Chr(13))
             
       a.WriteLine
        coluna = 3
        a.Write (Chr(9) & _
        "<Cidade>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</Cidade>" & Chr(13))
                
        a.WriteLine
        coluna = 4
        a.Write (Chr(9) & _
        "<DataInicio>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</DataInicio>" & Chr(13))
                
        
        a.WriteLine
        coluna = 5
        a.Write (Chr(9) & _
        "<DataConclusao>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</DataConclusao>" & Chr(13))
                
           
        a.WriteLine
        coluna = 6
        a.Write (Chr(9) & _
        "<Valor>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</Valor>" & Chr(13))
    
   

            linha = linha + 1
            
    'finaliza o arquivo
    a.Close


        Loop
    End With
 
    
 
    MsgBox "Exportação concluída!"
End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Wagner Morel
Manda bem
Manda bem
Mensagens: 107
Registrado em: Qua Nov 29, 2017 11:51 am
Localização: Fortaleza - CE

Re: Exportar para XML apenas as células preenchidas

Mensagem por Wagner Morel »

Você pode anexar aqui no fórum seu arquivo compactado com .ZIP?


lboff
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Sex Mar 15, 2019 11:36 pm

Re: Exportar para XML apenas as células preenchidas

Mensagem por lboff »

Segue abaixo arquivos.
Anexos
Teste Macro.zip
(19.79 KiB) Baixado 190 vezes


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Exportar para XML apenas as células preenchidas

Mensagem por Reinaldo »

veja se atende

Código: Selecionar todos

Sub ExportToXml()
    Dim linha As Long, coluna As Long, colunas As Long
    linha = 2
    colunas = ActiveSheet.UsedRange.Columns.Count
With ActiveSheet
    Do While Not IsEmpty(.Cells(linha, 1))
    
Set fs = CreateObject("Scripting.FileSystemObject")

Set a = fs.CreateTextFile(Cells(linha, 1).Value & ".xml", True)

'cria as primeiras linhas
a.WriteLine ("<?xml file>")
a.WriteLine ("<IncluirRelatorioFinanceiro>")
     
    coluna = 1
    If Len(RTrim(.Cells(linha, coluna).Value)) > 0 Then
        a.Write (Chr(9) & _
        "<NumeroDocumento>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</NumeroDocumento>" & Chr(13))
        a.WriteLine
    End If
    coluna = 2
    If Len(RTrim(.Cells(linha, coluna).Value)) > 0 Then
        a.Write (Chr(9) & _
        "<NomeTomadorServico>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</NomeTomadorServico>" & Chr(13))
        a.WriteLine
     End If
    coluna = 3
    If Len(RTrim(.Cells(linha, coluna).Value)) > 0 Then
        a.Write (Chr(9) & _
        "<Cidade>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</Cidade>" & Chr(13))
    a.WriteLine
     End If
    coluna = 4
    If Len(RTrim(.Cells(linha, coluna).Value)) > 0 Then
        a.Write (Chr(9) & _
        "<DataInicio>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</DataInicio>" & Chr(13))
    a.WriteLine
      End If
    coluna = 5
    If Len(RTrim(.Cells(linha, coluna).Value)) > 0 Then
        a.Write (Chr(9) & _
        "<DataConclusao>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</DataConclusao>" & Chr(13))
    a.WriteLine
End If
    coluna = 6
    If Len(RTrim(.Cells(linha, coluna).Value)) > 0 Then
        a.Write (Chr(9) & _
        "<Valor>" & _
        RTrim(.Cells(linha, coluna).Value) & _
        "</Valor>" & Chr(13))
    End If

        linha = linha + 1
        
    'finaliza o arquivo
    a.Close
    Loop
End With
    MsgBox "Exportação concluída!"
End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


lboff
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Sex Mar 15, 2019 11:36 pm

Re: Exportar para XML apenas as células preenchidas

Mensagem por lboff »

Funcionou, muito obrigada!


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder