この記事は2年以上前に書かれたものです。
情報が古い可能性が非常に高いです。

このエントリーをはてなブックマークに追加

「ExcelでiPhoneアプリ情報をまとめる」ってあんまりないシチュエーションかとは思いますが…いざやるとなるとiTunes Storeが文字列をコピペできないので凄く面倒です。そこで以前に掲載したPHP版のサンプルをExcel VBAに書き換えたので共有します。ちょっと改造すると特定アプリのアップデートチェッカーになるかもしれません。

ファイルダウンロード

2009-12-03追記 iPhoneと過ごした500日まとめ(付録:アプリ表の作り方)の記事で最新版を配布しています。

2009/09/21 Release:0.1.0-sample(010-sample.zip 89.3KB)

  • テストした環境は以下の通りです。
    • Windows XP SP3(Parallels Desktop 4.0)
    • Microsoft Excel 2007
      2003以前は環境ないので確認できません。動かなければごめんなさい。
    • 以下のコンポーネントを利用しています。そのため以下のコンポーネントがない、バージョンが違う場合、動作しない可能性があります。(参照設定の方が実行速度早いですが、配布時の参照設定の説明が面倒なので…)
      • Scripting.Dictionary
      • VBScript.RegExp
      • WinHttp.WinHttpRequest.5.1
      • ADODB.Stream
      • MSXML2.DOMDocument
      • ScriptControl
  • ファイル内に含まれるファイルは以下の通りです。
    • appinfo.xls … マクロを含む.xlsファイル
    • appinfo.xlsm … マクロを含む.xlsmファイル(上記と同内容)

注意事項

  • 上記の環境以外での動作はしない可能性があります。
  • iTunes Storeの仕様変更によりご利用できなくなる可能性があります。
  • いつも通りサンプル扱いなのでエラー処理、文字コード変換処理(ADODB.Streamでやってます)の検証が甘いです。その点、ご了承ください。
  • サンプルの使用および使用結果について、使用者および第三者が直接的および間接的ないかなる損害に対しても、制作者は一切の責任を負いません。

概要・使い方

概要

このサンプルはiTunes StoreをWebスクレイピングしてアプリ情報を取得するサンプルです。大量のアプリ情報をまとめて取得したいとき、iTunes Storeの文字列を手打ちしたくないときなどに利用できます。リリース日、バージョンなどを照らし合わせるよう改造すれば、アップデートチェックもできるかと思います。

モジュール構成

  • Sheet1 … サンプルデータを含むシート
  • Module1 … 「簡単な呼び出しサンプル」及びSheet1を使った「アプリ情報取得」を含む標準モジュール
  • iTunesViewSoftware … iTunes Storeからアプリ情報を取得するクラスモジュール

使い方1 : 簡単な呼び出しサンプル

マクロ::簡単な呼び出しサンプルにはiTunesViewSoftwareクラスの基本的な呼び出しサンプルを記載してあります。
とりあえずマクロ::簡単な呼び出しサンプルを実行してください。以下のようなメッセージボックスが表示されれば正常に動作してます。

iTunesViewSoftwareの使い方はこんな感じ。

  1. .LoadAppInfoメソッドでアプリID(もしくはアプリ情報ページのURL)を指定して呼び出し。0で成功。
  2. .getAppinfoメソッドでScripting.Dictionaryオブジェクトを取得。
  3. 上記オブジェクトのkeyを指定して情報を表示。
    キーの一覧は以下の通り。
    • アプリID … ID
    • 作者 … SELLAR
    • アイコンのURL … ICON_W100_URL
    • iTunesへのURL … URL
    • LinkShareアフェリエイトURL … LINKSHARE_URL
    • アプリ名 … NAME
    • カテゴリ … CATEGORY
    • リリース … REREASED
    • 販売業者 … SELLAR2
    • コピーライト … COPYRIGHT
    • バージョン … VERSION
    • サイズ … SIZE
    • 金額 … PRICE
    • レーティング … RATING
    • 新機能 … NEWFEATURES
    • 制限 … LIMITATION
    • ウェブサイト … WEBSITE
    • サポートサイト … SUPPORTSITE
.LoadAppInfoメソッドの前に、.setLinkShareIdプロパティにリンクシェアアフェリエイトのIDを渡して、アフェリエイトURLを生成することも可能です。

Sub 簡単な呼び出しサンプル()
Dim lngRet As Long
Dim objAppInfo As Object
Dim item As Variant

'クラスをインスタンス化
Dim objiTunes As New iTunesViewSoftware

'引数にアプリIDもしくはアプリページのURLを指定。(9桁整数が含まれるかチェックしかしてません。)
'成功ならlngRet = 0になります。それ以外なら通常エラー処理です。
lngRet = objiTunes.LoadAppInfo("306937983")
If lngRet <> 0 Then
   lngRet = MsgBox(objiTunes.getErrorDescription, vbCritical)
   Exit Sub
End If

'取得した情報をコピーします。
'Scripting.Dictionaryオブジェクトです。
Set objAppInfo = objiTunes.getAppinfo

'Scripting.Dictionaryのキー一覧を表示。
For Each item In objAppInfo.keys
    Debug.Print item    'イミディエイトウィンドウをご覧ください。 - [表示]メニューにあります。
Next

'キーを指定してメッセージボックスに表示
lngRet = MsgBox("アプリ名:" & objAppInfo.item("NAME") & vbCrLf & _
                "作者:" & objAppInfo.item("SELLAR") & vbCrLf & _
                "サイズ:" & objAppInfo.item("SIZE") & vbCrLf & _
                "バージョン:" & objAppInfo.item("VERSION"), vbInformation)

'オブジェクトを綺麗に。
Set objAppInfo = Nothing
Set objiTunes = Nothing
End Sub

使い方2 : 簡単な呼び出しサンプル

こちらはアクティブなシートのA列に記載されたアプリID(もしくはURL)を読み取って、B列以降に値を書き込みます。尚、念のため1行毎に0.5秒の間隔を空けています。

実行前


実行後

サンプルは29行目にKindle(日本のストアでは買えない)のアプリIDを入れているので、最後は必ずエラーになります。

'アクティブシートA列のアプリID(もしくはURL)を読み取ってB列以降にアプリ情報を書き込みます。
Sub アプリ情報取得()
On Error GoTo ERROR_HANDLER

Const SHORI_KAISHI_GYOU = 3 '処理を開始したい行を指定

Dim lngRet As Long

Dim objiTunes As New iTunesViewSoftware
Dim objAppInfo As Object
Dim item As Variant

Dim error_flg As Long
error_flg = 0

Dim i As Long
Dim l As Long
i = SHORI_KAISHI_GYOU
Do Until ActiveSheet.Range("A" & CStr(i)).Value = ""
    lngRet = objiTunes.LoadAppInfo(ActiveSheet.Range("A" & CStr(i)).Value)
    If lngRet = 0 Then
        Set objAppInfo = objiTunes.getAppinfo
        l = 0
        For Each item In objAppInfo.items
                ActiveSheet.Range(Chr(66 + l) & CStr(i)).Value = item   'B列からスタート
                l = l + 1
        Next
    Else
        error_flg = -1
        Exit Do
    End If
    i = i + 1
    Call Delay  '処理を0.5秒止めます。
Loop

If error_flg <> 0 Then
ERROR_HANDLER:
    lngRet = MsgBox("エラーが発生しました。:" & CStr(i) & "行目:" & objiTunes.getErrorDescription & IIf(Err.Number = 0, "", ":" & Err.Number & ":" & Err.Description), vbCritical)
    ActiveSheet.Range("A" & CStr(i)).Select
End If

Set objAppInfo = Nothing
Set objiTunes = Nothing
End Sub
Private Sub Delay()
    Dim s As Single
    s = Timer()
    Do While Timer() < s + 0.5  '処理を0.5秒止めます。(連続でiTunes Storeにアクセスしない。)
        Application.StatusBar = "0.5秒の間隔を開けています..."
        DoEvents
    Loop
    Application.StatusBar = False
End Sub

メモ

元にしたPHP版のサンプルも十分汚いですが、VBAはExcel 2000時代以来なので汚さが増しているかと思います…何卒ご容赦ください。とりいそぎ共有まで。
以下はクラスモジュールのソースです。

'/***
' *
' * iTunesからアプリ情報を取得するクラスモジュールサンプル
' *
' * VBA(for MicroSoft Excel 2007)
' *
' * @category    Web Services
' * @package     iTunesviewSoftware
' * @author      goodegg <mail@goodegg.jp>
' * @copyright   2008-2009 goodegg.jp
' * @license     http://opensource.org/licenses/mit-license.php MIT License
' * @version     Release:0.1.0-sample
' * @link        http://goodegg.jp/
' ***/
Option Explicit
'----
Private pAppinfo As Object
'----
Private Const cVIEWSOFTWAREURL = "http://ax.itunes.apple.com/WebObjects/MZStore.woa/wa/viewSoftware?id=###AppID###&mt-8"
Private Const cVIEWSOFTWAREURL_RESTR = "###AppID###"
Private Const cUSERAGENT = "iTunes/9.0 (Windows; U; Windows NT 6.0; ja-JP) AppleWebKit/531.9"
Private Const cXAPPLESTOREFTONT = "143462-9"
'----
Private pUSERAGENT As String
Private pXAPPLESTOREFTONT As String
Private pERROR As String
Private pLINKSHAREID As String
'/******************************
'リンクシェアのIDを指定する
'******************************/
Public Property Let setLinkShareId(linkshareid As String)
    '形式チェックなし
    pLINKSHAREID = linkshareid
End Property
'/******************************
'クラス内でエラーが発生したときの文字列を取得する
'(主にgetAppInfo向け)
'******************************/
Public Property Get getErrorDescription() As String
    getErrorDescription = pERROR
End Property
'/******************************
'アプリ情報を取得する。
'Scripting.Dictionaryなオブジェクトで返します。
'******************************/
Public Property Get getAppinfo() As Object
    Set getAppinfo = pAppinfo
End Property
Private Sub Class_Initialize()
    pLINKSHAREID = "SoaPt8v61lk"

    '以下がAppinfoのargに指定するモノ
    Set pAppinfo = CreateObject("Scripting.Dictionary")
    pAppinfo.Add "ID", ""               'アプリID
    pAppinfo.Add "SELLAR", ""           '作者
    pAppinfo.Add "ICON_W100_URL", ""    'アイコンのURL
    pAppinfo.Add "URL", ""              'iTunesへのURL
    pAppinfo.Add "LINKSHARE_URL", ""    'LinkShareアフェリエイトURL
    pAppinfo.Add "NAME", ""             'アプリ名
    pAppinfo.Add "CATEGORY", ""         'カテゴリ
    pAppinfo.Add "REREASED", ""         'リリース
    pAppinfo.Add "SELLAR2", ""          '販売業者
    pAppinfo.Add "COPYRIGHT", ""        'コピーライト
    pAppinfo.Add "VERSION", ""          'バージョン
    pAppinfo.Add "SIZE", ""             'サイズ
    pAppinfo.Add "PRICE", ""            '金額
    pAppinfo.Add "RATING", ""           'レーティング
    pAppinfo.Add "NEWFEATURES", ""      '新機能
    pAppinfo.Add "LIMITATION", ""       '制限
    pAppinfo.Add "WEBSITE", ""          'ウェブサイト
    pAppinfo.Add "SUPPORTSITE", ""      'サポートサイト


End Sub
Private Sub Class_Terminate()
    Set pAppinfo = Nothing
End Sub
'/******************************
'アプリ情報をiTunesから取得する。
'AppID
'   9桁のアプリIDもしくはアプリIDを含むURLを指定してください。
'戻り値
'    0 ... 正常終了
'   -1 ... エラー
'******************************/
Public Function LoadAppInfo(ByVal appid As String) As Long
    LoadAppInfo = -1

    Dim http As Object
    Dim doc As Object
    Dim reg As Object
    Dim m As Object
    Dim stream As Object

    Dim url As String
    Dim retStr As String
    Dim b() As Byte

    Dim i As Long
    Dim l As Long

    Dim s As String

    Dim Nodes As Object
    Dim NEWFEATURES As String
    Dim LIMITATION As String

    pERROR = "getAppInfo:開始処理"

    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "[0-9]{9}"
    reg.Global = False
    Set m = reg.Execute(appid)
    If m.Count <> 1 Then
        pERROR = "getAppInfo:アプリIDの指定が不正です。9桁の整数を含む値を指定してください。"
        GoTo FUNCTION_TERMINATE
    End If
    appid = m.item(0).Value
    url = cVIEWSOFTWAREURL
    url = Replace(url, cVIEWSOFTWAREURL_RESTR, appid)

    pERROR = "getAppInfo:XML取得処理"
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")

    With http
        .Open "GET", url, False
        .SetRequestHeader "User-Agent", cUSERAGENT
        .SetRequestHeader "X-Apple-Store-Front", cXAPPLESTOREFTONT
        .send
        If .Status <> 200 Then
            pERROR = "getAppInfo:XML取得に失敗:" & CStr(.Status)
            GoTo FUNCTION_TERMINATE
        End If

    pERROR = "getAppInfo:XML解析処理"
        '制御コードが混じっているとおかしくなるかも。(未実証)
        '"\0", "\x01", "\x02", "\x03", "\x04", "\x05", "\x06", "\x07", "\x08", "\x0b", "\x0c", "\x0e", "\x0f"
        Set stream = CreateObject("ADODB.Stream")
        With stream
            .Open
            .Type = 1 'adTypeBinary
            .write http.responsebody()
            .Position = 0
            .Type = 2 'adtypetext
            .Charset = "UTF-8"
            retStr = .readtext()
            .Close
        End With
        Set stream = Nothing
    End With


    Set doc = CreateObject("MSXML2.DOMDocument")
    doc.LoadXML (retStr)
    'idがおかしいとか、利用できないとか
    '「ご希望のアイテムは、現在日本語の Store ではご利用いただけません。」のパターンのみ検証済み。
    Set Nodes = doc.DocumentElement.SelectNodes("/plist/dict/key[1]")
    If Not Nodes(0) Is Nothing Then
        If Nodes(0).Text = "failureType" Then
                pERROR = "getAppInfo:たぶん日本語のStoreではご利用頂けないアプリです。"
                GoTo FUNCTION_TERMINATE
        End If
    End If
    Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/@backColor")
    If Nodes(0).Text = "ffffff" And appid <> "300719251" Then    'とりあえず... Keynote Remoto対応。通常画面と美麗画面の見分け方はまた調べる。
        '通常画面
        NEWFEATURES = ""
        LIMITATION = ""
        For i = 0 To 4
            Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[1]/VBoxView[1]/TextView[" & CStr(i) & "]/SetFontStyle/b")
            If Not Nodes(0) Is Nothing Then
                s = Nodes(0).Text
                Select Case s
                    Case "このバージョンの新機能:"
                        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[1]/VBoxView[1]/TextView[" & CStr(i + 1) & "]/SetFontStyle")
                        NEWFEATURES = Nodes(0).Text
                    Case "条件:"
                        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[1]/VBoxView[1]/TextView[" & CStr(i + 1) & "]/SetFontStyle")
                        LIMITATION = Nodes(0).Text
                End Select
            End If
        Next

        'ID
        pAppinfo.item("ID") = appid

        'SELLAR
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/GotoURL/TextView/SetFontStyle/b")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("SELLAR") = Nodes(0).Text
        End If

        'ICON_W100_URL
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/VBoxView[0]/MatrixView/GotoURL/View/PictureView/@url")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("ICON_W100_URL") = Nodes(0).Text
        End If

        'URL
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/Path/PathElement[2]")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("URL") = Replace(Nodes(0).Text, "http://ax.", "http://")
        End If

        'LinkShareアフェリエイトURL
        pAppinfo.item("LINKSHARE_URL") = makeLinkShareURL(pAppinfo.item("URL"))

        'アプリ名
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/VBoxView[0]/MatrixView/VBoxView/TextView[0]/SetFontStyle/GotoURL")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("NAME") = Nodes(0).Text
        End If

        'カテゴリ/リリース/販売業者/コピーライト/バージョン/サイズ
        For l = 1 To 6
            Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/VBoxView[0]/MatrixView/VBoxView/TextView[" & CStr(l) & "]/SetFontStyle")
            If Not Nodes(0) Is Nothing Then
                s = Nodes(0).Text
                Select Case l
                    Case 1
                        pAppinfo.item("CATEGORY") = Trim(Replace(Nodes(0).Text, "カテゴリー:", ""))
                    Case 2
                        pAppinfo.item("REREASED") = Trim(Replace(Nodes(0).Text, "リリース", ""))
                    Case 3
                        pAppinfo.item("SELLAR2") = Trim(Replace(Nodes(0).Text, "販売業者 : ", ""))
                    Case 4
                        pAppinfo.item("COPYRIGHT") = Trim(Right(s, Len(s) - 2))
                    Case 5
                        pAppinfo.item("VERSION") = Trim(Replace(Nodes(0).Text, "バージョン: ", ""))
                    Case 6
                        pAppinfo.item("SIZE") = Trim(Nodes(0).Text)
                End Select
            End If
        Next

        '金額
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/VBoxView[0]/MatrixView/VBoxView/HBoxView/VBoxView[0]/HBoxView/VBoxView/TextView/SetFontStyle/b")
        If Not Nodes(0) Is Nothing Then
            s = Nodes(0).Text
            If s <> "無料" Then
                s = Right(s, Len(s) - 1)
            End If
            pAppinfo.item("PRICE") = s
        End If

        'レーティング
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/VBoxView[0]/MatrixView/VBoxView/VBoxView/TextView/SetFontStyle/GotoURL")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("RATING") = Trim(Replace(Replace(Replace(Nodes(0).Text, "以下の理由により", ""), "のレーティングがついています。", ""), "レート", ""))
        End If

        '新機能
        pAppinfo.item("NEWFEATURES") = NEWFEATURES

        '制限
        pAppinfo.item("LIMITATION") = Replace(Replace(LIMITATION, "          ", ""), vbLf, " ")

        'ウェブサイト
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[1]/VBoxView[1]/VBoxView/VBoxView[0]/HBoxView/OpenURL/@url")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("WEBSITE") = Nodes(0).Text
        End If
        'サポートサイト
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[1]/VBoxView[1]/VBoxView/VBoxView[1]/HBoxView/OpenURL/@url")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("SUPPORTSITE") = Nodes(0).Text
        End If
    Else
        '美麗画面 - バイオ4とか特別版ページ
        NEWFEATURES = ""
        LIMITATION = ""
        For i = 0 To 4
            Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[1]/VBoxView[1]/TextView[" & CStr(i) & "]/SetFontStyle/b")
            If Not Nodes(0) Is Nothing Then
                s = Nodes(0).Text
                Select Case s
                    Case "このバージョンの新機能:"
                        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[1]/VBoxView[1]/TextView[" & CStr(i + 1) & "]/SetFontStyle")
                        NEWFEATURES = Nodes(0).Text
                    Case "条件:"
                        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[1]/VBoxView[1]/TextView[" & CStr(i + 1) & "]/SetFontStyle")
                        LIMITATION = Nodes(0).Text
                End Select
            End If
        Next

        'ID
        pAppinfo.item("ID") = appid

        'SELLAR
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/View[0]/View/VBoxView/VBoxView[0]/MatrixView/VBoxView/TextView[1]/SetFontStyle/GotoURL")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("SELLAR") = Nodes(0).Text
        End If

        'ICON_W100_URL
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/View[0]/View/VBoxView/VBoxView[0]/MatrixView/GotoURL/View/HBoxView/View[1]/PictureView/@url")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("ICON_W100_URL") = Nodes(0).Text
        End If

        'URL
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/Path/PathElement[2]")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("URL") = Replace(Nodes(0).Text, "http://ax.", "http://")
        End If

        'LinkShareアフェリエイトURL
        pAppinfo.item("LINKSHARE_URL") = makeLinkShareURL(pAppinfo.item("URL"))

        'アプリ名
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/View[0]/View/VBoxView/VBoxView[0]/MatrixView/VBoxView/TextView[0]/SetFontStyle/GotoURL")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("NAME") = Nodes(0).Text
        End If
        'カテゴリ/リリース/販売業者/コピーライト/バージョン/サイズ
        For l = 2 To 7
            Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/View[0]/View/VBoxView/VBoxView[0]/MatrixView/VBoxView/TextView[" & CStr(l) & "]/SetFontStyle")
            If Not Nodes(0) Is Nothing Then
                s = Nodes(0).Text
                Select Case l
                    Case 2
                        pAppinfo.item("CATEGORY") = Trim(Replace(Nodes(0).Text, "カテゴリー:", ""))
                    Case 3
                        pAppinfo.item("REREASED") = Trim(Replace(Nodes(0).Text, "リリース", ""))
                    Case 4
                        pAppinfo.item("SELLAR2") = Trim(Replace(Nodes(0).Text, "販売業者 : ", ""))
                    Case 5
                        pAppinfo.item("COPYRIGHT") = Trim(Right(s, Len(s) - 2))
                    Case 6
                        pAppinfo.item("VERSION") = Trim(Replace(Nodes(0).Text, "バージョン: ", ""))
                    Case 7
                        pAppinfo.item("SIZE") = Trim(Nodes(0).Text)
                End Select
            End If
        Next

        '金額
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/View[0]/View/VBoxView/VBoxView[0]/MatrixView/VBoxView/HBoxView/VBoxView[0]/HBoxView/VBoxView/TextView/SetFontStyle/b")
        If Not Nodes(0) Is Nothing Then
            s = Nodes(0).Text
            If s <> "無料" Then
                s = Right(s, Len(s) - 1)
            End If
            pAppinfo.item("PRICE") = s
        End If

        'レーティング
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[0]/View[0]/View/VBoxView/VBoxView[0]/MatrixView/VBoxView/VBoxView/TextView/SetFontStyle/GotoURL")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("RATING") = Trim(Replace(Replace(Replace(Nodes(0).Text, "以下の理由により", ""), "のレーティングがついています。", ""), "レート", ""))
        End If
        '新機能
        pAppinfo.item("NEWFEATURES") = NEWFEATURES

        '制限
        pAppinfo.item("LIMITATION") = Replace(Replace(LIMITATION, "          ", ""), vbLf, " ")

        'ウェブサイト
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[1]/VBoxView[1]/VBoxView/VBoxView[0]/HBoxView/OpenURL/@url")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("WEBSITE") = Nodes(0).Text
        End If

        'サポートサイト
        Set Nodes = doc.DocumentElement.SelectNodes("/Document/View/ScrollView/VBoxView/View/MatrixView/VBoxView[0]/View/MatrixView/VBoxView[1]/VBoxView[1]/VBoxView/VBoxView[0]/HBoxView/OpenURL/@url")
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item("SUPPORTSITE") = Nodes(0).Text
        End If
    End If

    pERROR = "getAppInfo:処理完了"
    LoadAppInfo = 0

FUNCTION_TERMINATE:
    Set http = Nothing
    Set doc = Nothing
    Set reg = Nothing
    Set m = Nothing
    Set Nodes = Nothing
End Function
Private Function makeLinkShareURL(ByVal url As String) As String
    makeLinkShareURL = "http://click.linksynergy.com/fs-bin/stat?id=" & pLINKSHAREID & _
                    "&offerid=94348&type=3&subid=0&tmpid=2192&RD_PARM1=" & _
                    urlencode(urlencode(url)) & "%2526uo%253D6%2526partnerId%253D30"

End Function
Private Function urlencode(ByVal s As String) As String
    Dim obj As Object
    Set obj = CreateObject("ScriptControl")
    obj.Language = "Jscript"
    urlencode = obj.CodeObject.encodeURIComponent(s)
    Set obj = Nothing
End Function
このエントリーをはてなブックマークに追加