Boa tarde ! Estou tentando escrever em tags dentro de subpastas na pasta dados mas não está indo. Se rodo o codigo por uma tela no click de um botão ele escreve normalmente, mas o que queria era deixar na area de OnPreset dentro de um CounterTag. Não acuse nenhum erro no script no log. Alguem pode me ajudar ?
Esse seria o escript dentro do OnPreset, que está igual ao script do botão na tela :
Sub Leitura_Simuc_OnPreset()
Dim urlProtegido,http, jsonTexto,sc,jsCode,todosRegistrosDict, listaRegistros(), i, caminhoBase, registro, idAtual, objSimuc
token = Parent.Item(“Token”).Value
'Essa linha abaixo coloquei apenas como teste e não está escrevendo o valor na variável
Application.GetObject(":Dados.KDL.SIMUCs.[2533001568]").idSIMUC = “teste”
urlProtegido = "https://simcidadesinteligentes.com.br:44300/lista-simucs/v1"
Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
http.open "GET", urlProtegido, False
http.setRequestHeader "Authorization", "Bearer " & token
http.setRequestHeader "Accept", "application/json"
http.send
jsonTexto = http.responseText
’ Cria e configura o ScriptControl
Set sc = CreateObject(“MSScriptControl.ScriptControl”)
sc.Language = “JScript”
’ Adiciona uma função JScript inteligente para extrair o valor da propriedade de forma limpa
jsCode = “function parseJsonParaDicionarios(jsonStr) {” & _
" var obj = eval(’(’ + jsonStr + ‘)’);" & _
" var dictList = new ActiveXObject(‘Scripting.Dictionary’);" & _
" for (var i = 0; i < obj.data.length; i++) {" & _
" var item = obj.data[i];" & _
" var info = new ActiveXObject(‘Scripting.Dictionary’);" & _
" info.Add(‘idSimuc’, String(item.idSimuc));" & _
" info.Add(‘etiqueta’, String(item.etiqueta));" & _
" info.Add(‘idSimcon’, String(item.idSimcon));" & _
" info.Add(‘lat’, String(item.lat));" & _
" info.Add(‘lng’, String(item.lng));" & _
" info.Add(‘status’, String(item.status));" & _
" info.Add(‘type’, String(item.type));" & _
" info.Add(‘result’, String(item.result));" & _
" dictList.Add(i, info);" & _
" }" & _
" return dictList;" & _
“}”
’ Injeta e compila a função JavaScript na memória do componente para deixá-la pronta para uso
sc.AddCode jsCode
’ Executa tudo com apenas UMA chamada
Set todosRegistrosDict = sc.Run(“parseJsonParaDicionarios”, jsonTexto)
’ Transforma o retorno em uma Array (se você realmente precisar do formato Array)
ReDim listaRegistros(todosRegistrosDict.Count - 1)
For i = 0 To todosRegistrosDict.Count - 1
Set listaRegistros(i) = todosRegistrosDict.Item(i)
Next
’ Caminho base da pasta onde estão os objetos dos SIMUCs no Elipse
caminhoBase = “:Dados.KDL.SIMUCs.”
’ Ignora erros temporariamente para testar se o objeto existe antes de escrever
On Error Resume Next
’ Varre toda a lista de registros que você extraiu do JSON
For i = 0 To UBound(listaRegistros)
Set registro = listaRegistros(i)
' Pega o ID do registro atual para montar o caminho do objeto
idAtual = registro("idSimuc")
' Tenta capturar o objeto específico dentro da pasta do Elipse
' Exemplo: Application.GetObject(":Dados.KDL.SIMUCs.[1234567891]")
Set objSimuc = Application.GetObject(caminhoBase & "[" & idAtual & "]")
' Se o objeto foi encontrado com sucesso na pasta, limpa o erro e grava os dados
If Err.Number = 0 Then
' Grava cada informação extraída no seu respectivo campo dentro do objeto do Elipse
objSimuc.idSIMUC = registro("idSimuc")
objSimuc.etiqueta = registro("etiqueta")
objSimuc.idSimcon = registro("idSimcon")
objSimuc.lat = registro("lat")
objSimuc.lng = registro("lng")
objSimuc.status = registro("status")
objSimuc.type = registro("type")
objSimuc.result = registro("result")
Else
' Caso o idSimuc do JSON não exista como objeto na pasta do Elipse,
' ele ignora e limpa o erro para não travar a execução do script
Err.Clear
End If
' Libera a referência do objeto para o próximo ciclo
Set objSimuc = Nothing
Next
’ Restaura o comportamento padrão de erros do VBScript
On Error GoTo 0
’ 1. Limpa todos os dicionários que foram guardados dentro da Array
For i = 0 To UBound(listaRegistros)
Set listaRegistros(i) = Nothing
Next
Erase listaRegistros ’ Apaga a estrutura da array dinâmica da memória
’ 2. Limpa os objetos principais e coleções
Set registro = Nothing
Set todosRegistrosDict = Nothing
Set sc = Nothing
Set http = Nothing
End Sub