Automatický import dat o firmě z registru ARES pomocí makra s XML dotazem

Upozornění:

Následující návod už je trochu zastaralý a po změně rozhraní API nefunkční. Doporučujeme spíše novější postup s použitím Power Query.

Starší návod využívající makro:

Tvoříte v Excelu šablonu faktury nebo objednávky? Potřebujete mít v excelovské databázi aktuální informace o vašich obchodních partnerech? Pak tyto informace nemusíte zadávat manuálně. Zadáte IČO a zbylé údaje se samy stáhnou z internetu. A jak na to? Pojďme krok za krokem.

(pokud Vám stačí jednoduché jednorázové zjištění informací dle IČ, podívejte se na tento návod)

Připravíme si fomulář v Excelu

Připravíme si v Excelu formulář, do kterého chceme údaje automaticky načíst. Formulář bude obsahovat informace: IČO, Název firmy, adresa popř. jiné další. Může vypadat např. takto

obr1

Najdeme registr ARES na internetu

Na adrese http://wwwinfo.mfcr.cz/ares/ares_es.html.cz je provozováno rozhraní do registru. My hledáme možnost, jak dotazy na firmy posílat z Excelu.

To lze řešit pomocí makra, ve kterém použijeme tento odkaz: http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_bas.cgi?ico=27074358, kde poslední parametr je ičo. Více o dalších parametrech a možnostech dotazování najdeme na http://wwwinfo.mfcr.cz/ares/ares_xml_basic.html.cz.

Jak bude makro pracovat

Než ťukneme do klávesnice, měli bychom si říci, jak má makro zhruba fungovat. Řekněme, že chceme, aby byl proces následující:

  • Do buňky C2 zadáme IČO
  • Klikneme na tlačítko, které makro spustí
  • Makro natáhne data do pomocného listu, který se předtím vytvoří
  • Do buněk C4 C6 C8 a C10 se zkopírují údaje z pomocného listu
  • Pomocný list se smaže
  • Na závěr se zobrazí hlášení, že je vše hotovo.

V makru, kde budeme pracovat s pomocnými listy a pak je odstraňovat, je dobré využít možnosti potlačit obnovování obrazovky během běhu makra a také potlačení chybových hlášek. To bude mít za efekt zrychlení celého makra a nebude docházet k „problikávání“ listů apod. během běhu makra. Na konci makra je pak nutné oba potlačené prvky opět obnovit. Jak na to je uvedeno níže přímo v kódu makra.

Zapíšeme kód makra

Spustíme editor maker (ikona Visual Basic) ,která je na záložce vývojář. Po načtené okna vybereme v levé části okna položku „This Workbook“, neboť chceme makro použít v rámci jednoho souboru.

Následující kód makra si můžete zkopírovat přímo do editoru, jednotlivé kroky makra jsou popsány komentáři přímo v makru:

Sub ares()

Application.ScreenUpdating = False 'potlačí obnovování obrazovky
Application.DisplayAlerts = False 'potlačí varovné hlášky

'vloží nový list na konec se jménem ares
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ares"

Sheets("ares").Activate 'přesun na tento nový list
'XML dotaz do ARESU s tím, že ičo máme na první listu v buňce C2 a importovná data chceme vložit do buňky A1
ActiveWorkbook.XmlImport URL:="http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?ico=" & Sheets(1).Range("C2").Value, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")

Sheets(1).Activate 'přesun zpět na první list

'přenesení údajů z pomocného listu do kolonek formuláře
Sheets(1).Range("C4") = Sheets("ares").Range("AJ3") 'přenesení názvu firmy
Sheets(1).Range("C6") = Sheets("ares").Range("DA3") 'přenesení ulice
Sheets(1).Range("C8") = Sheets("ares").Range("CW3") 'přenesení města
Sheets(1).Range("C10") = Sheets("ares").Range("DF3") 'přenesení PSč

Sheets("ares").Delete 'smazání pomocného listu

Application.ScreenUpdating = True 'zapne obnovování obrazovky
Application.DisplayAlerts = FaTruelse 'obnoví varovné hlášky

End Sub

Chcete-li se podívat, jaké další údaje se z ARESU stahují, stačí, pokud odmažete poslední příkaz makra a pomocný list tak po importu nezmizí. Pak se budete moci podívat, jaká data se stáhla a v jakých buňkách je najdete pro další zpracování.

Dokončíme formulář a makro spustíme

Pokud jsme makro do editoru vložili, vraťme se zpět do listu z formulářem, kde ještě přidáme tlačítko, které makro vyvolá. To provedeme takto

  • Jdeme na záložku Vývojář -> Vložit -> ovládací prvky formuláře -> Tlačítko.
  • tlačítko „nakreslíme“ v prostoru listu excelu myší do požadovaných rozměrů
  • Ihned po té se nám zobrazí okno s možností přiřadit tomuto tlačítku makro. Vybereme makro s názvem : ThisWorkbook.ares.
  • Tlačítko vhodně pojmenujeme
  • Vepíšeme do buňky C2 nějaké ičo, u kterého chceme doplnit zbylé údaje
  • A je to! Zde je výsledek:

obr2

Pokud je to pro vás lepší, můžete si stáhnout hotový soubor ares.xlsm, který již obsahuje funkční formulář.

ares.xlsx

1 Komentář

  2. Nabízím náznak alternativního řešení:

    Sub VypisARES()

    ‘Tools/References, Microsoft XML, v6.0

    Dim strURL As String
    Dim strFirma As String
    Dim strMesto As String
    Dim strUlice As String
    Dim strCisloDomovni As String
    Dim strPSC As String

    ‘http://wwwinfo.mfcr.cz/ares/ares_xml_standard.html
    ‘http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?ico=27074358

    ‘Asseco Central Europe, a.s.
    ‘202724222
    ‘203
    ‘Hlavní město Praha
    ‘Praha
    ‘Michle
    ‘Praha 4
    ‘Budějovická
    ‘778
    ‘3a
    ‘14000

    ‘URL adresa
    strURL = “http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?ico=27074358”

    Dim oXml As MSXML2.DOMDocument60
    Set oXml = New MSXML2.DOMDocument60

    With oXml

    ‘načtení XML
    .async = False
    .Load strURL

    ‘načtení hodnot konkrétních nodů/tagů
    strFirma = .getElementsByTagName(“are:Obchodni_firma”).Item(0).Text
    strMesto = .getElementsByTagName(“dtt:Nazev_obce”).Item(0).Text
    strUlice = .getElementsByTagName(“dtt:Nazev_ulice”).Item(0).Text
    strCisloDomovni = _
    .getElementsByTagName(“dtt:Cislo_domovni”).Item(0).Text
    strPSC = .getElementsByTagName(“dtt:PSC”).Item(0).Text

    End With

    ‘odstranění z paměti
    Set oXml = Nothing

    End Sub

  3. Mám takový pocit, že se mi podařilo zablokovat přístup na infomfcr. Co se s tím dá dělat ?

  4. Dobrý den,

    nevíte, jak by takovýto skript vypadal v OpenOffice?

  6. Děkuji za odpověď. Ten jsem již zkoušel, ale bez úspěchu bohužel.

  7. Dobrý den. Funguje to.
    Pro mou potřebu bych to ale potřeboval upravit tak, aby to doplnilo najednou adresy u více subjektů.
    Například, kdybych měl ve sloupci A nasekaná IČa jednotlivých subjektů by to mohlo doplnit sloupce B,C,D,E adresou.

    Nemá někdo nápad?
    Díky

  8. Dobrý den, prostě byste makro volal vícekrát a ukládal makrem za sebou.
    Je je možné, jak upozorňuje jeden z diskutujících tady, že po mnohonásobném volání vám zdroj omezí přístup. Nemám s tím ale žádnou vlastní zkušenost…

  9. A mohl by sem někdo nahrát fungující makro v ODF tedy? Mně stránka s konvertorem nefunguje. Předem děkuji.

  10. Dobrý den,

    díky moc za skvělý kod. Bylo by možné jej upravit tak, aby se hledalo nejen mezi aktivními subjekty, ale zobrazovaly se i výsledky vyhledávání pro zaniklé subjekty?

    Děkuji.

    Jakub

  11. Už asi vím 🙂

    ActiveWorkbook.XmlImport ActiveWorkbook.XmlImport URL:=”http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?ico=” & Sheets(1).Range(“C2”).Value & “&aktivni=false”, ImportMap:=Nothing, Overwrite:=True, Destination:=Range(“$A$1”)

  12. Dobrý den, děkuji za tento návod. Jen by mě zajímalo jestli je možné nějak zrychlit toto makro. Docela dlouho trvá než se vygenerují požadovaná data.

  13. Ještě prosím o informaci jak zjistit range (např. bych chtěl přidat DIČ)

  14. Davide, prip. ostatni, mate nekdo hotovy XLS soubor, ktery na zaklade ICO ve sloupci automaticky doplni dalsi udaje? Velmi by mi to pomohlo. Diky Ales Email na me: ales.agenda@seznam.cz

  17. Pěkný a funkční návod, dokud MFČR nezměnilo server a systém podávání infomací. Má někdo řešení k novénu ARESu?
    Nějak se mi nedaří pořešit import (potřebuji IČO, DIČ, a adresu ze sídla).
    Díky

Komentáře není možné přidávat