Ir ao conteúdo
  • Cadastre-se
ErickSant

Excel VBA excel montar arquivo JSON

Recommended Posts

Prezados,
bom dia!

 

preciso de uma ajuda para criar um script em vba que leia um excel e com algumas informações específicas desse arquivo, monte um arquivo JSON... Segue a ideia:

Seguindo o arquivo em anexo, o objetivo é ler as seguintes colunas e pegar as informações de cada uma e ir montando o arquivo JSON...

 

Coluna E (Invoice Date) = "DataEmissaoNF": "conteudo",
Coluna G(Due Date) = "VencimentoNF":"conteudo",
Coluna H(Gross Amount)= "ValorTotalNF":"conteudo",
Coluna L(Pay Stat)= "StatusPag":"conteudo",
Coluna N(Supplier Number)= "NumForn":"conteudo",
Coluna O(Supplier Number Desc)= "NomeForn":"conetudo",
Coluna P(Invoice Number)= "NumeroNF":"conteudo"

 

 

Outra dúvida também seria que esse script puxaria as informações do excel sempre do mesmo diretório...

 

Alguém consegue me ajudar ?

 

Obrigado...

 

Book1.xls

Editado por DiF
Botão CODE <>

Compartilhar este post


Link para o post
Compartilhar em outros sites

Algum programador consegue me ajudar ? Achei um vídeo com uma ideia parecida com o que eu quero, mas não consegui adaptar o código...

 

 

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá,

bom dia,

 

Achei o seguinte código na internet, mas não estou conseguindo adaptar o Range... Alguém consegue me ajudar ?

 

Option Explicit

Sub export_in_json_format()

    Dim fs As Object
    Dim jsonfile
    Dim rangetoexport As Range
    Dim rowcounter As Long
    Dim columncounter As Long
    Dim linedata As String

    
    ' change range here
   Set rangetoexport = Worksheets("Sheet1").Range("E1", "G1", "H1", "L1", "N1", "O1", "P1") << eu precisaria dessas colunas apenas...
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    ' change dir here
    
    Set jsonfile = fs.CreateTextFile("C:\Users\Erick\Desktop\" & "jsondata.json", True)
    
    linedata = "{""Output"": ["
    jsonfile.WriteLine linedata
    For rowcounter = 2 To rangetoexport.Rows.Count
        linedata = ""
        For columncounter = 1 To rangetoexport.Columns.Count
            linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.Cells(rowcounter, columncounter) & """" & ","
        Next
        linedata = Left(linedata, Len(linedata) - 1)
        If rowcounter = rangetoexport.Rows.Count Then
            linedata = "{" & linedata & "}"
        Else
            linedata = "{" & linedata & "},"
        End If
        
        jsonfile.WriteLine linedata
    Next
    linedata = "]}"
    jsonfile.WriteLine linedata
    jsonfile.Close
    
    Set fs = Nothing
    
    
End Sub


 

 

Galera, acredito que estou chegando perto do que eu desejo... Vejam o código abaixo por favor.

Sub export_in_json_format()

    Dim fs As Object
    Dim jsonfile
    Dim rangetoexport As Range
    Dim rowcounter As Long
    Dim columncounter As Long
    Dim linedata As String
    Dim UltimaLinhaAtivaE As Long
    Dim UltimaLinhaAtivaG As Long
    Dim UltimaLinhaAtivaH As Long
    Dim UltimaLinhaAtivaL As Long
    Dim UltimaLinhaAtivaN As Long
    Dim UltimaLinhaAtivaO As Long
    Dim UltimaLinhaAtivaP As Long
    

    UltimaLinhaAtivaE = Planilha1.Cells(Planilha1.Rows.Count, 5).End(xlUp).Row
    UltimaLinhaAtivaG = Planilha1.Cells(Planilha1.Rows.Count, 7).End(xlUp).Row
    UltimaLinhaAtivaH = Planilha1.Cells(Planilha1.Rows.Count, 7).End(xlUp).Row
    UltimaLinhaAtivaL = Planilha1.Cells(Planilha1.Rows.Count, 12).End(xlUp).Row
    UltimaLinhaAtivaN = Planilha1.Cells(Planilha1.Rows.Count, 14).End(xlUp).Row
    UltimaLinhaAtivaO = Planilha1.Cells(Planilha1.Rows.Count, 15).End(xlUp).Row
    UltimaLinhaAtivaP = Planilha1.Cells(Planilha1.Rows.Count, 16).End(xlUp).Row
    
     
    ' range 
Set rangetoexport = Worksheets("Sheet1").Range("N1:N" & UltimaLinhaAtivaN, "E1:E" & UltimaLinhaAtivaE)    'AQUI se eu configurar até 2 colunas( N e E) ele passa tranquilo e faz exatamente o que eu quero... Porém se eu colocar na ordem que eu quero, ele da erro...


'a ordem das colunas que eu quero colocar é N, O, P, H, G, L, E
'no caso seguiria a mesma lógica
'exemplo
'Set rangetoexport = Worksheets("Sheet1").Range("N1:N" & UltimaLinhaAtivaN, "O1:O" & UltimaLinhaAtivaO, "P1:P" & UltimaLinhaAtivaP, "H1:H" & UltimaLinhaAtivaH, "G1:G" & UltimaLinhaAtivaG, "L1:L" & UltimaLinhaAtivaL, "E1:E" & UltimaLinhaAtivaE)

 

 

Alguém consegue me ajudar ??

 

até consegui ajeitar, mas o resultado ele ignora algumas colunas...

 

Option Explicit

Sub export_in_json_format()

    Dim fs As Object
    Dim jsonfile
    Dim rangetoexport As Range
    Dim rowcounter As Long
    Dim columncounter As Long
    Dim linedata As String
    Dim UltimaLinhaAtivaE As Long
    Dim UltimaLinhaAtivaG As Long
    Dim UltimaLinhaAtivaH As Long
    Dim UltimaLinhaAtivaL As Long
    Dim UltimaLinhaAtivaN As Long
    Dim UltimaLinhaAtivaO As Long
    Dim UltimaLinhaAtivaP As Long
    Dim r1 As Range
    Dim r2 As Range
    Dim r3 As Range
    Dim r4 As Range
    Dim r5 As Range
    Dim r6 As Range
    Dim r7 As Range
    
    UltimaLinhaAtivaE = Planilha1.Cells(Planilha1.Rows.Count, 5).End(xlUp).Row
    UltimaLinhaAtivaG = Planilha1.Cells(Planilha1.Rows.Count, 7).End(xlUp).Row
    UltimaLinhaAtivaH = Planilha1.Cells(Planilha1.Rows.Count, 7).End(xlUp).Row
    UltimaLinhaAtivaL = Planilha1.Cells(Planilha1.Rows.Count, 12).End(xlUp).Row
    UltimaLinhaAtivaN = Planilha1.Cells(Planilha1.Rows.Count, 14).End(xlUp).Row
    UltimaLinhaAtivaO = Planilha1.Cells(Planilha1.Rows.Count, 15).End(xlUp).Row
    UltimaLinhaAtivaP = Planilha1.Cells(Planilha1.Rows.Count, 16).End(xlUp).Row
    
    
    Set r1 = Worksheets("Sheet1").Range("N1:N" & UltimaLinhaAtivaN)
    Set r2 = Worksheets("Sheet1").Range("O1:O" & UltimaLinhaAtivaO)
    Set r3 = Worksheets("Sheet1").Range("P1:P" & UltimaLinhaAtivaP)
    Set r4 = Worksheets("Sheet1").Range("H1:H" & UltimaLinhaAtivaH)
    Set r5 = Worksheets("Sheet1").Range("G1:G" & UltimaLinhaAtivaG)
    Set r6 = Worksheets("Sheet1").Range("L1:L" & UltimaLinhaAtivaL)
    Set r7 = Worksheets("Sheet1").Range("E1:E" & UltimaLinhaAtivaE)
    
    
    
    
    
    ' change range here
    Set rangetoexport = Union(r1, r2, r3, r4, r5, r6,r7)

    Set fs = CreateObject("Scripting.FileSystemObject")
    ' change dir here
    
    Set jsonfile = fs.CreateTextFile("C:\Users\erick.l.santiago\Desktop\" & "jsondata.json", True)
    
    linedata = "{""Output"": ["
    jsonfile.WriteLine linedata
    For rowcounter = 2 To rangetoexport.Rows.Count
        linedata = ""
        For columncounter = 1 To rangetoexport.Columns.Count
            linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.Cells(rowcounter, columncounter) & """" & ","
        Next
        linedata = Left(linedata, Len(linedata) - 1)
        If rowcounter = rangetoexport.Rows.Count Then
            linedata = "{" & linedata & "}"
        Else
            linedata = "{" & linedata & "},"
        End If
        
        jsonfile.WriteLine linedata
    Next
    linedata = "]}"
    jsonfile.WriteLine linedata
    jsonfile.Close
    
    Set fs = Nothing
    
End Sub



'resultado':



{"Output": [
{"Supplier Number":"20136570","Supplier Number Desc":"fornecedor1","Invoice Number":""},
{"Supplier Number":"40016609","Supplier Number Desc":"fornecedor2","Invoice Number":"000050412000"},
{"Supplier Number":"40018644","Supplier Number Desc":"fornecedor3","Invoice Number":"10006600"},
{"Supplier Number":"40017433","Supplier Number Desc":"fornecedor4","Invoice Number":"00912200"},
{"Supplier Number":"40017966","Supplier Number Desc":"fornecedor5","Invoice Number":"00055900"}
]}


 

O certo era trazer mais algumas informações...

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×