「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を生成することも可能です。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 |
: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 'イミディエイトウィンドウをご覧ください。 - [表示]メニューにあります。 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を入れているので、最後は必ずエラーになります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 |
: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 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時代以来なので汚さが増しているかと思います...何卒ご容赦ください。とりいそぎ共有まで。
以下はクラスモジュールのソースです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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> ' * @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解析処理" '制御コードが混じっているとおかしくなるかも。(未実証) '" ", "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 |
