Díky - neutr - nějak jsem to zbastlil. Trochu je tam problém s tím že čárky mohou být i v argumentech, ale dalo se to překonat. Zároveň je riziko že hledané heslo bud součástí i jiných hesel (např. "dic"). Nakonec mám ale pocit že to rozdělování na řádky ani není nutné. Jaké to má výhody? Existuje i jakási novější funkce v novějším LO: =PARSEJSON(JSON,Pattern). Bohužel musím mít z různých důvodů starší office. Tož můj makro bastl:
dIco = list.getCellByPosition(sloupec, radek).value
xmlHtp = CreateObject("MSXML2.XMLHTTP")
oleService = createUnoService("com.sun.star.bridge.OleObjectFactory")
XMLDOC = oleService.createInstance("Msxml.DOMDocument")
if dIco <> 0 Then
ico = Format(dIco,"00000000")
sURL = "[url]https://ares.gov.cz/ekonomicke-subjekty-v-be/rest/ekonomicke-subjekty/[/url]" & ico
'http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_bas.cgi?ico= ' STARÉ XML
xmlHtp.Open "GET", sURL, False
xmlHtp.Send
XMLDOC.loadXML xmlHtp.responseText
strResponse = xmlHtp.responseText
strResponse = Replace(strResponse, CHR(34), "") 'Odstranit veškeré uvozovky
Dim Pattern(6) as string
Pattern = Array("obchodniJmeno","nazevUlice","cisloDomovni","cisloOrientacni","psc","nazevObce","dic") 'hledaná hesla
strResponse = Replace(strResponse, ", ", "+ZZZ+") 'nahradím čárku s mezerou nějakým jedinečným znakem
For i = 0 to 6
izacatek = InStr(1, strResponse, Pattern(i)) + LEN(Pattern(i)) + 1
ikonec = InStr(izacatek, strResponse,",")
Hodnota(i) = MID(strResponse, izacatek, ikonec - izacatek)
Hodnota(i) = Replace(Hodnota(i), "+ZZZ+", ", ") 'nahradím jedinečný znak za čárku s mezerou
print Hodnota(i)
Next i
else
msgbox ("Je zapotřebí nechat kurzor na ič",0,"Repete")
end if
Editoval ludviktrnka (6. 1. 2024 17:37:41)