Skip to content

Instantly share code, notes, and snippets.

@carlosfaddul
Last active January 10, 2023 11:21
Show Gist options
  • Select an option

  • Save carlosfaddul/c70332ccdbc5b7870c0f53b1f11b022e to your computer and use it in GitHub Desktop.

Select an option

Save carlosfaddul/c70332ccdbc5b7870c0f53b1f11b022e to your computer and use it in GitHub Desktop.
Converte a Tabela ativa do excel para um aquivo JSON
Public Sub SheetsToJSON()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
jsonFilename = fso.GetBaseName(ActiveWorkbook.Name) & ".json" 'Aqui será salvo o nome do arquivo JSON baseado na sua tabela ativa do Excel'
fullFilePath = Application.ActiveWorkbook.Path & "\" & jsonFilename 'Aqui definirá o caminho que será salvo o arquivo JSON gerado'
Dim fileStream As Object
Set fileStream = CreateObject("ADODB.Stream")
fileStream.Type = 2
fileStream.Charset = "utf-8" 'Define o formato do charset que será exportado o arquivo'
fileStream.Open 'Irá abrir o arquivo JSON e começará a escrever os objetos JSON
Dim Pasta_de_Trabalho As Workbook
Set Pasta_de_Trabalho = ThisWorkbook
Dim wks As Worksheet
Set wks = Pasta_de_Trabalho.Sheets(1)
Coluna_Esquerda = wks.Cells(1, Columns.Count).End(xlToLeft).Column
Linha_Esquerda = wks.Cells(Rows.Count, "A").End(xlUp).Row
Dim titles() As String
ReDim titles(Coluna_Esquerda)
For i = 1 To Coluna_Esquerda
titles(i) = wks.Cells(1, i)
Next i
fileStream.WriteText "[" ' Nesta linha, começa o tratamento do arquivo JSON, abrindo o conchetes inicial do Array de objetos / Tabela Ativa
dq = """"
escapedDq = "\"""
For j = 2 To Linha_Esquerda
For i = 1 To Coluna_Esquerda
If i = 1 Then
fileStream.WriteText "{" 'Nesta linha, começa a escrita do Objeto / Linha do Excel
End If
cellvalue = Replace(wks.Cells(j, i), dq, escapedDq)
fileStream.WriteText dq & titles(i) & dq & ":" & dq & cellvalue & dq
If i <> Coluna_Esquerda Then
fileStream.WriteText "," ' Aqui delimitar os objetos dentro do objeto / Coluna do excel
End If
Next i
fileStream.WriteText "}" 'Nesta linha, terminará a escrita do Objeto / último valor da linha do excel
If j <> Linha_Esquerda Then
fileStream.WriteText "," 'Nesta linha, começa a tratativa do próximo Objeto / último valor de colunas do excel
End If
Next j
fileStream.WriteText "]" ' Aqui irá encerrar o tratamento do arquivo JSON, fechando o conchetes inicial do Array de objetos
fileStream.SaveToFile fullFilePath, 2 'Salva o arquivo no computador
a = MsgBox("Saved to " & fullFilePath, vbOKOnly)
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment