Excel VBA excel montar arquivo JSON

ErickSant · 28 de maio de 2018

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

ErickSant · 29 de maio de 2018

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...

ErickSant · 30 de maio de 2018

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...

Felippe Mendes Macedo · 5 de outubro de 2022

Já se passaram mais de quatro anos e ninguém respondeu... Conseguiu solucionar seu problema?

AfonsoMira · 6 de outubro de 2022

Boas,

Penso que assim já resolveria:

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
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.ActiveSheet
    
    With ws
        UltimaLinhaAtivaE = .Cells(.Rows.Count, 5).End(xlUp).Row
        UltimaLinhaAtivaG = .Cells(.Rows.Count, 7).End(xlUp).Row
        UltimaLinhaAtivaH = .Cells(.Rows.Count, 7).End(xlUp).Row
        UltimaLinhaAtivaL = .Cells(.Rows.Count, 12).End(xlUp).Row
        UltimaLinhaAtivaN = .Cells(.Rows.Count, 14).End(xlUp).Row
        UltimaLinhaAtivaO = .Cells(.Rows.Count, 15).End(xlUp).Row
        UltimaLinhaAtivaP = .Cells(.Rows.Count, 16).End(xlUp).Row
        
        Set r1 = .Range("N1:N" & UltimaLinhaAtivaN)
        Set r2 = .Range("O1:O" & UltimaLinhaAtivaO)
        Set r3 = .Range("P1:P" & UltimaLinhaAtivaP)
        Set r4 = .Range("H1:H" & UltimaLinhaAtivaH)
        Set r5 = .Range("G1:G" & UltimaLinhaAtivaG)
        Set r6 = .Range("L1:L" & UltimaLinhaAtivaL)
        Set r7 = .Range("E1:E" & UltimaLinhaAtivaE)
    End With
    
    
    
    ' 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 7
            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