Wikipediaのサーチボックスにキーワードを入力すると、入力したキーワードと似ている予測キーワードがリスト表示されます(ここではこの機能をオートコンプリートと呼ぶことにします)。

今回はこの予測キーワード一覧を配列として取得するマクロを考えてみました。

Option Explicit

Public Sub Sample()
  Dim v As Variant
  Dim i As Long
  
  Debug.Print "- Wikipedia(日本語版)"
  v = GetWikipediaAutocomplete("テスト")
  If IsEmpty(v) = False Then
    For i = LBound(v) To UBound(v)
      Debug.Print v(i)
    Next
  End If
  Debug.Print ""
  
  Debug.Print "- Wikipedia(英語版)"
  v = GetWikipediaAutocomplete("abc", "en")
  If IsEmpty(v) = False Then
    For i = LBound(v) To UBound(v)
      Debug.Print v(i)
    Next
  End If
  Debug.Print ""
  
  Debug.Print "- Wikipedia(マケドニア語版)"
  v = GetWikipediaAutocomplete("ab", "mk")
  If IsEmpty(v) = False Then
    For i = LBound(v) To UBound(v)
      Debug.Print v(i)
    Next
  End If
End Sub

Private Function GetWikipediaAutocomplete(ByVal key_word As String, _
                                          Optional ByVal language As String = "ja") As Variant
'Wikipediaオートコンプリートからキーワード取得
'http://www.mediawiki.org/wiki/API:Main_page/ja
  Dim d As Object
  Dim lst As Object
  Dim n As Object
  Dim v As Variant
  Dim url As String
  Dim i As Long
  
  Set d = Nothing: Set lst = Nothing '初期化
  If ChkWikipediaLanguage(LCase(language)) = False Then language = "ja"
  url = "http://" & LCase(language) & ".wikipedia.org/w/api.php?action=opensearch&format=xml&search="
  url = url & EncodeURL(key_word)
  On Error Resume Next
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False
    .setRequestHeader "Content-Type", "text/xml; charset=UTF-8"
    .send
    Select Case .Status
      Case 200: Set d = .responseXML
    End Select
  End With
  If Not d Is Nothing Then
    Set lst = d.getElementsByTagName("Text")
    ReDim v(lst.Length - 1): i = LBound(v)
    For Each n In lst
      v(i) = n.Text
      i = i + 1
    Next
  End If
  On Error GoTo 0
  GetWikipediaAutocomplete = v
End Function

Private Function ChkWikipediaLanguage(ByVal language As String) As Boolean
'Wikipediaの対応言語判定
'http://meta.wikimedia.org/wiki/List_of_Wikipedias
  Dim ret As Boolean
  
  ret = True '初期化
  Select Case LCase(language)
    Case "en" 'English
    Case "sv" 'Swedish
    Case "de" 'German
    Case "nl" 'Dutch
    Case "fr" 'French
    Case "war" 'Waray-Waray
    Case "ceb" 'Cebuano
    Case "ru" 'Russian
    Case "it" 'Italian
    Case "es" 'Spanish
    Case "vi" 'Vietnamese
    Case "pl" 'Polish
    Case "ja" 'Japanese
    Case "pt" 'Portuguese
    Case "zh" 'Chinese
    Case "uk" 'Ukrainian
    Case "ca" 'Catalan
    Case "fa" 'Persian
    Case "no" 'Norwegian (Bokm?l)
    Case "fi" 'Finnish
    Case "id" 'Indonesian
    Case "ar" 'Arabic
    Case "cs" 'Czech
    Case "sr" 'Serbian
    Case "ko" 'Korean
    Case "hu" 'Hungarian
    Case "sh" 'Serbo-Croatian
    Case "ms" 'Malay
    Case "ro" 'Romanian
    Case "tr" 'Turkish
    Case "min" 'Minangkabau
    Case "kk" 'Kazakh
    Case "eo" 'Esperanto
    Case "eu" 'Basque
    Case "sk" 'Slovak
    Case "da" 'Danish
    Case "bg" 'Bulgarian
    Case "lt" 'Lithuanian
    Case "he" 'Hebrew
    Case "hr" 'Croatian
    Case "hy" 'Armenian
    Case "sl" 'Slovenian
    Case "et" 'Estonian
    Case "uz" 'Uzbek
    Case "simple" 'Simple English
    Case "gl" 'Galician
    Case "vo" 'Volap?k
    Case "nn" 'Norwegian (Nynorsk)
    Case "el" 'Greek
    Case "hi" 'Hindi
    Case "la" 'Latin
    Case "az" 'Azerbaijani
    Case "th" 'Thai
    Case "ka" 'Georgian
    Case "oc" 'Occitan
    Case "be" 'Belarusian
    Case "mk" 'Macedonian
    Case "ce" 'Chechen
    Case "mg" 'Malagasy
    Case "new" 'Newar / Nepal Bhasa
    Case "ur" 'Urdu
    Case "ta" 'Tamil
    Case "tt" 'Tatar
    Case "pms" 'Piedmontese
    Case "cy" 'Welsh
    Case "tl" 'Tagalog
    Case "te" 'Telugu
    Case "lv" 'Latvian
    Case "bs" 'Bosnian
    Case "be-x-old" 'Belarusian (Tara?kievica)
    Case "br" 'Breton
    Case "ht" 'Haitian
    Case "sq" 'Albanian
    Case "jv" 'Javanese
    Case "lb" 'Luxembourgish
    Case "mr" 'Marathi
    Case "is" 'Icelandic
    Case "ml" 'Malayalam
    Case "zh-yue" 'Cantonese
    Case "bn" 'Bengali
    Case "af" 'Afrikaans
    Case "ba" 'Bashkir
    Case "pnb" 'Western Panjabi
    Case "ga" 'Irish
    Case "my" 'Burmese
    Case "lmo" 'Lombard
    Case "fy" 'West Frisian
    Case "yo" 'Yoruba
    Case "tg" 'Tajik
    Case "an" 'Aragonese
    Case "cv" 'Chuvash
    Case "sco" 'Scots
    Case "sw" 'Swahili
    Case "ky" 'Kirghiz
    Case "ne" 'Nepali
    Case "io" 'Ido
    Case "gu" 'Gujarati
    Case "bpy" 'Bishnupriya Manipuri
    Case "scn" 'Sicilian
    Case "nds" 'Low Saxon
    Case "ku" 'Kurdish
    Case "ast" 'Asturian
    Case "qu" 'Quechua
    Case "als" 'Alemannic
    Case "gd" 'Scottish Gaelic
    Case "kn" 'Kannada
    Case "su" 'Sundanese
    Case "pa" 'Punjabi
    Case "am" 'Amharic
    Case "ckb" 'Sorani
    Case "ia" 'Interlingua
    Case "nap" 'Neapolitan
    Case "mn" 'Mongolian
    Case "bug" 'Buginese
    Case "bat-smg" 'Samogitian
    Case "wa" 'Walloon
    Case "arz" 'Egyptian Arabic
    Case "map-bms" 'Banyumasan
    Case "zh-min-nan" 'Min Nan
    Case "si" 'Sinhalese
    Case "mzn" 'Mazandarani
    Case "yi" 'Yiddish
    Case "fo" 'Faroese
    Case "sah" 'Sakha
    Case "bar" 'Bavarian
    Case "sa" 'Sanskrit
    Case "vec" 'Venetian
    Case "nah" 'Nahuatl
    Case "os" 'Ossetian
    Case "roa-tara" 'Tarantino
    Case "li" 'Limburgish
    Case "hsb" 'Upper Sorbian
    Case "or" 'Oriya
    Case "pam" 'Kapampangan
    Case "se" 'Northern Sami
    Case "ilo" 'Ilokano
    Case "mrj" 'Hill Mari
    Case "mi" 'Maori
    Case "mhr" 'Meadow Mari
    Case "hif" 'Fiji Hindi
    Case "bcl" 'Central Bicolano
    Case "frr" 'North Frisian
    Case "gan" 'Gan
    Case "bh" 'Bihari
    Case "bo" 'Tibetan
    Case "rue" 'Rusyn
    Case "glk" 'Gilaki
    Case "ps" 'Pashto
    Case "vls" 'West Flemish
    Case "nds-nl" 'Dutch Low Saxon
    Case "fiu-vro" 'V?ro
    Case "tk" 'Turkmen
    Case "pag" 'Pangasinan
    Case "diq" 'Zazaki
    Case "xmf" 'Mingrelian
    Case "co" 'Corsican
    Case "gv" 'Manx
    Case "sc" 'Sardinian
    Case "km" 'Khmer
    Case "csb" 'Kashubian
    Case "hak" 'Hakka
    Case "kv" 'Komi
    Case "zea" 'Zeelandic
    Case "crh" 'Crimean Tatar
    Case "vep" 'Vepsian
    Case "zh-classical" 'Classical Chinese
    Case "ay" 'Aymara
    Case "so" 'Somali
    Case "dv" 'Divehi
    Case "udm" 'Udmurt
    Case "kw" 'Cornish
    Case "eml" 'Emilian-Romagnol
    Case "nrm" 'Norman
    Case "rm" 'Romansh
    Case "wuu" 'Wu
    Case "koi" 'Komi-Permyak
    Case "ug" 'Uyghur
    Case "stq" 'Saterland Frisian
    Case "lad" 'Ladino
    Case "lij" 'Ligurian
    Case "fur" 'Friulian
    Case "szl" 'Silesian
    Case "as" 'Assamese
    Case "mt" 'Maltese
    Case "cbk-zam" 'Zamboanga Chavacano
    Case "gn" 'Guarani
    Case "pcd" 'Picard
    Case "pi" 'Pali
    Case "gag" 'Gagauz
    Case "ie" 'Interlingue
    Case "ksh" 'Ripuarian
    Case "ang" 'Anglo-Saxon
    Case "dsb" 'Lower Sorbian
    Case "ext" 'Extremaduran
    Case "cdo" 'Min Dong
    Case "ace" 'Acehnese
    Case "nv" 'Navajo
    Case "frp" 'Franco-Proven?al/Arpitan
    Case "kab" 'Kabyle
    Case "sn" 'Shona
    Case "mwl" 'Mirandese
    Case "lez" 'Lezgian
    Case "ln" 'Lingala
    Case "pfl" 'Palatinate German
    Case "krc" 'Karachay-Balkar
    Case "myv" 'Erzya
    Case "haw" 'Hawaiian
    Case "pdc" 'Pennsylvania German
    Case "xal" 'Kalmyk
    Case "rw" 'Kinyarwanda
    Case "nov" 'Novial
    Case "kaa" 'Karakalpak
    Case "to" 'Tongan
    Case "kl" 'Greenlandic
    Case "arc" 'Aramaic
    Case "ha" 'Hausa
    Case "bjn" 'Banjar
    Case "lo" 'Lao
    Case "kbd" 'Kabardian Circassian
    Case "av" 'Avar
    Case "pap" 'Papiamentu
    Case "ty" 'Tahitian
    Case "bxr" 'Buryat (Russia)
    Case "tpi" 'Tok Pisin
    Case "na" 'Nauruan
    Case "mdf" 'Moksha
    Case "lbe" 'Lak
    Case "jbo" 'Lojban
    Case "wo" 'Wolof
    Case "roa-rup" 'Aromanian
    Case "srn" 'Sranan
    Case "sd" 'Sindhi
    Case "ig" 'Igbo
    Case "tet" 'Tetum
    Case "nso" 'Northern Sotho
    Case "tyv" 'Tuvan
    Case "kg" 'Kongo
    Case "ab" 'Abkhazian
    Case "ltg" 'Latgalian
    Case "zu" 'Zulu
    Case "za" 'Zhuang
    Case "om" 'Oromo
    Case "mai" 'Maithili
    Case "tw" 'Twi
    Case "chy" 'Cheyenne
    Case "rmy" 'Romani
    Case "cu" 'Old Church Slavonic
    Case "chr" 'Cherokee
    Case "tn" 'Tswana
    Case "bi" 'Bislama
    Case "pih" 'Norfolk
    Case "rn" 'Kirundi
    Case "got" 'Gothic
    Case "sm" 'Samoan
    Case "bm" 'Bambara
    Case "xh" 'Xhosa
    Case "ss" 'Swati
    Case "mo" 'Moldovan
    Case "iu" 'Inuktitut
    Case "ki" 'Kikuyu
    Case "pnt" 'Pontic
    Case "lg" 'Luganda
    Case "ts" 'Tsonga
    Case "ee" 'Ewe
    Case "ak" 'Akan
    Case "ti" 'Tigrinya
    Case "fj" 'Fijian
    Case "ks" 'Kashmiri
    Case "sg" 'Sango
    Case "ff" 'Fula
    Case "ny" 'Chichewa
    Case "ve" 'Venda
    Case "st" 'Sesotho
    Case "ik" 'Inupiak
    Case "cr" 'Cree
    Case "dz" 'Dzongkha
    Case "tum" 'Tumbuka
    Case "ch" 'Chamorro
    Case "ng" 'Ndonga
    Case "ii" 'Sichuan Yi
    Case "cho" 'Choctaw
    Case "mh" 'Marshallese
    Case "aa" 'Afar
    Case "kj" 'Kuanyama
    Case "ho" 'Hiri Motu
    Case "mus" 'Muscogee
    Case "kr" 'Kanuri
    Case "hz" 'Herero
    Case Else: ret = False
  End Select
  ChkWikipediaLanguage = ret
End Function

Private Function EncodeURL(ByVal target_string As String) As String
'URLエンコード
  With CreateObject("ScriptControl")
    .language = "JScript"
    EncodeURL = .CodeObject.encodeURIComponent(target_string)
  End With
End Function

Wikipediaが対応している言語かどうかをチェックする「ChkWikipediaLanguage」プロシージャーのせいでコードが長くなってしまいましたが、やっていることはWikipediaのAPIにリクエストを投げ、結果をXMLで受け取って配列に格納するという、ごく単純なものです。

実際にどのような場面で使えるのか？、ということは置いておくとして、色々な言語のWikipediaでどのようなキーワードが出てくるのかを簡単に見ることができるのは中々面白いです。