App StoreからiPhoneアプリ情報を取得するExcel VBAサンプル

「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の使い方はこんな感じ。

.LoadAppInfoメソッドでアプリID(もしくはアプリ情報ページのURL)を指定して呼び出し。0で成功。
.getAppinfoメソッドでScripting.Dictionaryオブジェクトを取得。
上記オブジェクトの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を生成することも可能です。

:nocontrols:nogutter" ]
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(&quot;306937983&quot;)
If lngRet &lt;&gt; 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(&quot;アプリ名:&quot; &amp; objAppInfo.item(&quot;NAME&quot;) &amp; vbCrLf &amp; _
                &quot;作者:&quot; &amp; objAppInfo.item(&quot;SELLAR&quot;) &amp; vbCrLf &amp; _
                &quot;サイズ:&quot; &amp; objAppInfo.item(&quot;SIZE&quot;) &amp; vbCrLf &amp; _
                &quot;バージョン:&quot; &amp; objAppInfo.item(&quot;VERSION&quot;), vbInformation)

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

:nocontrols:nogutter" ]

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 'イミディエイトウィンドウをご覧ください。 - [表示]メニューにあります。

'キーを指定してメッセージボックスに表示

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を入れているので、最後は必ずエラーになります。

:nocontrols:nogutter" ]
'アクティブシート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(&quot;A&quot; &amp; CStr(i)).Value = &quot;&quot;
    lngRet = objiTunes.LoadAppInfo(ActiveSheet.Range(&quot;A&quot; &amp; CStr(i)).Value)
    If lngRet = 0 Then
        Set objAppInfo = objiTunes.getAppinfo
        l = 0
        For Each item In objAppInfo.items
                ActiveSheet.Range(Chr(66 + l) &amp; 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 &lt;&gt; 0 Then
ERROR_HANDLER:
    lngRet = MsgBox(&quot;エラーが発生しました。:&quot; &amp; CStr(i) &amp; &quot;行目:&quot; &amp; objiTunes.getErrorDescription &amp; IIf(Err.Number = 0, &quot;&quot;, &quot;:&quot; &amp; Err.Number &amp; &quot;:&quot; &amp; Err.Description), vbCritical)
    ActiveSheet.Range(&quot;A&quot; &amp; 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() &lt; s + 0.5  '処理を0.5秒止めます。(連続でiTunes Storeにアクセスしない。)
        Application.StatusBar = &quot;0.5秒の間隔を開けています...&quot;
        DoEvents
    Loop
    Application.StatusBar = False
End Sub

:nocontrols:nogutter" ]

'アクティブシート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

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時代以来なので汚さが増しているかと思います...何卒ご容赦ください。とりいそぎ共有まで。
以下はクラスモジュールのソースです。

:nocontrols:nogutter" ]
'/***
' *
' * iTunesからアプリ情報を取得するクラスモジュールサンプル
' *
' * VBA(for MicroSoft Excel 2007)
' *
' * @category    Web Services
' * @package     iTunesviewSoftware
' * @author      goodegg &lt;mail@goodegg.jp&gt;
' * @copyright   2008-2009 goodegg.jp
' * @license     http://opensource.org/licenses/mit-license.php MIT License
' * @version     Release:0.1.0-sample
' * @link        https://goodegg.jp/
' ***/
Option Explicit
'----
Private pAppinfo As Object
'----
Private Const cVIEWSOFTWAREURL = &quot;http://ax.itunes.apple.com/WebObjects/MZStore.woa/wa/viewSoftware?id=###AppID###&amp;mt-8&quot;
Private Const cVIEWSOFTWAREURL_RESTR = &quot;###AppID###&quot;
Private Const cUSERAGENT = &quot;iTunes/9.0 (Windows; U; Windows NT 6.0; ja-JP) AppleWebKit/531.9&quot;
Private Const cXAPPLESTOREFTONT = &quot;143462-9&quot;
'----
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 = &quot;SoaPt8v61lk&quot;

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


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 = &quot;getAppInfo:開始処理&quot;

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

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

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

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


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

        'ID
        pAppinfo.item(&quot;ID&quot;) = appid

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

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

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

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

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

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

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

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

        '新機能
        pAppinfo.item(&quot;NEWFEATURES&quot;) = NEWFEATURES

        '制限
        pAppinfo.item(&quot;LIMITATION&quot;) = Replace(Replace(LIMITATION, &quot;          &quot;, &quot;&quot;), vbLf, &quot; &quot;)

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

        'ID
        pAppinfo.item(&quot;ID&quot;) = appid

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

        'ICON_W100_URL
        Set Nodes = doc.DocumentElement.SelectNodes(&quot;/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&quot;)
        If Not Nodes(0) Is Nothing Then
            pAppinfo.item(&quot;ICON_W100_URL&quot;) = Nodes(0).Text
        End If

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

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

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

        '金額
        Set Nodes = doc.DocumentElement.SelectNodes(&quot;/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&quot;)
        If Not Nodes(0) Is Nothing Then
            s = Nodes(0).Text
            If s &lt;&gt; &quot;無料&quot; Then
                s = Right(s, Len(s) - 1)
            End If
            pAppinfo.item(&quot;PRICE&quot;) = s
        End If

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

        '制限
        pAppinfo.item(&quot;LIMITATION&quot;) = Replace(Replace(LIMITATION, &quot;          &quot;, &quot;&quot;), vbLf, &quot; &quot;)

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

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

    pERROR = &quot;getAppInfo:処理完了&quot;
    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 = &quot;http://click.linksynergy.com/fs-bin/stat?id=&quot; &amp; pLINKSHAREID &amp; _
                    &quot;&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=&quot; &amp; _
                    urlencode(urlencode(url)) &amp; &quot;%2526uo%253D6%2526partnerId%253D30&quot;

End Function
Private Function urlencode(ByVal s As String) As String
    Dim obj As Object
    Set obj = CreateObject(&quot;ScriptControl&quot;)
    obj.Language = &quot;Jscript&quot;
    urlencode = obj.CodeObject.encodeURIComponent(s)
    Set obj = Nothing
End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

:nocontrols:nogutter" ]

'/***

' *

' * iTunesからアプリ情報を取得するクラスモジュールサンプル

' *

' * VBA(for MicroSoft Excel 2007)

' *

' * @category Web Services

' * @package iTunesviewSoftware

' * @author goodegg <mail@goodegg.jp>

' * @license http://opensource.org/licenses/mit-license.php MIT License

' * @version Release:0.1.0-sample

' * @link https://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解析処理"

'制御コードが混じっているとおかしくなるかも。(未実証)

'"", "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

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

'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

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

'金額

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

'レーティング

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

'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

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"))

'アプリ名

If Not Nodes(0) Is Nothing Then

pAppinfo.item("NAME") = Nodes(0).Text

End If

'カテゴリ/リリース/販売業者/コピーライト/バージョン/サイズ

For l = 2 To 7

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

'金額

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

'レーティング

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

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

『いい感じ!』（good egg!）なモノやコトをご紹介。
全力で。たまに。たぶん。

App StoreからiPhoneアプリ情報を取得するExcel VBAサンプル

ファイルダウンロード

注意事項

概要・使い方

概要

モジュール構成

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

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

メモ

最近の投稿

最厚16mmのハイパワーマシン「Dell New XPS15 2in1...

New XPS 13と2週間ほど過ごしたのでレビュー

ASUS Chromebook Flip C101PAでVisual ...