Criar Arquivo JSON com VBA

Bom dia a todos!

Galera estou com um projeto que a princípio achei fácil mas agora vi que não é tããaao fácil assim.

Criei a rotina abaixo:

Dim linha As Long, coluna As Long, colunas As Long, Dir As String, longTotalLinhas As Long
Dim DirDestino As String, strChave As String, booChave As Boolean, intTamChave As Integer
linha = 2
colunas = ActiveSheet.UsedRange.Columns.Count
Set fs = CreateObject("Scripting.FileSystemObject")
Dir = ThisWorkbook.Path
DirDestino = "C:\Users\BT4T\Documents\Projetos\Petrobras\XML x JSON\bdNMxFAMILIAxDEPOSITO\"
'DirDestinoEQSB = "\\petrobras.biz\petrobras\SUB\SUB_EQSB_DISP_CM-II\NP-1\2- LOGÍSTICA\2.5-LOGÍSTICA OFICINA\DiretrizMateriaisARM\bd\"
Arquivo = "NMxFamila.json"

'Set a = fs.CreateTextFile(ThisWorkbook.FullName & ".xml", True)
'Endereço Final
'Set a = fs.CreateTextFile("\\petrobras.biz\petrobras\LMS\LMS_US-LOG_OLNF_ARM_CR\NP-1\EP-SERV_US-LOG_LOGM_ARM_CDEP_NP-1\01. Orientações\12. Rearruma\bdNMxFAMILIAxDEPOSITO\NMxFamila.xml", True)
Set a = fs.CreateTextFile(Dir & "\" & Arquivo, True)
'cria as primeiras linhas
'a.WriteLine ("")
a.WriteLine ("var dados = {")
a.WriteLine (Chr(9) & Chr(34) & "NM Familia" & Chr(34) & " : [")
longTotalLinhas = ThisWorkbook.Worksheets("ARM").Cells(Rows.Count, 1).End(xlUp).Row

With ActiveSheet
Do While Not IsEmpty(.Cells(linha, 1))
booChave = True
For coluna = 1 To colunas Step 1
If booChave Then
strChave = Chr(9) & Chr(9) & "{"
booChave = False
End If
If coluna <> colunas Then
strChave = strChave & (Chr(34) & .Cells(1, coluna).Value & Chr(34) & ":" & _
Chr(34) & RTrim(.Cells(linha, coluna).Value) & _
Chr(34) & ", ")
Else
strChave = strChave & (Chr(34) & .Cells(1, coluna).Value & Chr(34) & ":" & _
Chr(34) & RTrim(.Cells(linha, coluna).Value) & Chr(34))
End If
Debug.Print strChave
Next
intTamChave = Len(strChave)
'strChave = Left(strChave, intTamChave - 1)
strChave = strChave & "}"
If longTotalLinhas <> linha Then
strChave = strChave & ","
End If
'Debug.Print strChave
a.Write strChave
a.WriteLine (Chr(9))
linha = linha + 1
Loop
End With

'finaliza o arquivo
a.WriteLine (Chr(9) & "]")
a.WriteLine ("};")
a.Close

Debug.Print "Json Gerado com Sucesso!!!"

FileCopy Dir & "\" & Arquivo, DirDestino & Arquivo
Sleep 10000
FileCopy Dir & "\" & Arquivo, DirDestinoEQSB & Arquivo

Kill Dir & "\" & Arquivo

Essa rotina cria um arquivo JSON dentro dos parâmetros JSON.
Porém quando fui abrir o arquivo .JSON no Power BI a título de teste me retorna o erro: Detalhes: "Encontrámos carateres adicionais no final da entrada JSON."

Isso me remete a hipótese de haver algum erro na criação do arquivo...

Alguma idéia? Não sei nada sobre JSON....

Bom dia

Utilize este ou outro editor JSON para verificar onde está o erro do arquivo gerado, e então adapte o código para evitar tal erro.