【エクセルvbaでウェブスクレイピング】1つの商品に対して複数の仕入れ先の在庫管理ができるツールを作成した

こんにちは。

りゅうぴぃです。

• 1つの商品に対して複数の仕入れ先の在庫管理ができるツールを探している
• ある程度出来上がった在庫管理ツールを自分なりにカスタマイズしたい
• vbaでのウェブスクレイピングに興味があり、活用方法を知りたい

と思いの方におすすめです。

さっそくですが、作成したツールで在庫管理を行った動画です。

他にもこんなツール作ってます

【ボタンを押すだけ爆速で出品、在庫管理】 ebay無在庫販売ツールGEKIRAKU

特徴

ある商品に対して複数のショップを監視し、在庫の有無を調べることができます。

動作

１「URLシート」のショップURL＋「在庫管理シート」の検索ワードを組み合わせてできたURLにアクセスします。
例ヨドバシの場合　https://www.yodobashi.com/product/10000000　+ 検索ワード〇〇〇〇〇〇〇

2アクセス後表示された画面に「在庫管理シート」で定義した登録ワードのいずれかが存在する場合⇒〇、存在しない場合⇒×と判定します。また、ショップ１から順に巡回し、いずれかのショップに在庫がある場合は在庫有りとして、次の商品に移ります。

利用方法

①URL登録
「URLシート」でショップのURLを登録します。
例ヨドバシの場合　https://www.yodobashi.com/product/10000000
②検索ワード、登録ワードの登録
それぞれの商品について検索ワード(ISBIN, JANコードなど),登録ワード(在庫あり、カートに入れるなど)
③在庫チェックの実行

注意点

ユーザーが入力する箇所は検索ワード、登録ワード、ショップURLのみとなります。それ以外の箇所を変更したりすると正常に動作しなくなる可能性がありますのでご注意ください

表示された画面に対して登録ワードが存在するかを在庫有無の判断としているため、⇒のように関係のない場所に登録ワードが存在したとしても誤認してしまいますので、登録ワードの選択には十分ご注意ください。

ポイント

こちらのツールはただ動けばいいではなくて、メンテナンスのしやさ、コードの可読性の高さを意識して、作成しました。
その際に参考にした記事はおなじみの@ntakahashi0505さんの下の記事です。
すごくわかりやすいですね。https://t.co/8Pfj5v9n9a

— りゅうぴぃ副業戦士@IT&eBay輸出 (@RyukiLol) May 28, 2019

それと@ntakahashi0505さんが出版されている

「エクセルVBAを実務で使い倒す」っていう本ですね。

VBAはある程度かけるけど、さらに
読みやすくて、かっこいい（簡潔な）コードを書きたい人におすすめですね。

— りゅうぴぃ副業戦士@IT&eBay輸出 (@RyukiLol) May 31, 2019

Excel　VBAを実務で使い倒す技術／高橋宣成【1000円以上送料無料】 価格：1944円（税込、送料無料) (2019/5/31時点)

ソースコード

Enum eURL
ショップ1 = 1
ショップ2
ショップ3
ショップ4
ショップ5
ショップ6
ショップ7
ショップ8
ショップ9
ショップ10
ショップ11
ショップ12
ショップ13
ショップ14
ショップ15
ショップ16
ショップ17
ショップ18
ショップ19
ショップ20
End Enum

Sub Zaiko()
‘定義

‘テーブル
Dim tbZaiko As ListObject: Set tbZaiko = wsZaiko.ListObjects(“在庫管理”)
Dim tbURL As ListObject: Set tbURL = wsURL.ListObjects(“URLマスタ”)

‘在庫管理シートのテーブルのデータ行
Dim rowZaiko As ListRow
Dim colZaiko As ListColumn
‘行での繰り返し
For Each rowZaiko In tbZaiko.ListRows
‘検索キーワード
keyword = IIf(rowZaiko.Range(eZaiko.登録ワード).value <> “”, rowZaiko.Range(eZaiko.登録ワード).value, “登録ワードが存在しない”)
keyword2 = IIf(rowZaiko.Range(eZaiko.登録ワード2).value <> “”, rowZaiko.Range(eZaiko.登録ワード2).value, “登録ワード2が存在しない”)
keyword3 = IIf(rowZaiko.Range(eZaiko.登録ワード3).value <> “”, rowZaiko.Range(eZaiko.登録ワード3).value, “登録ワード3が存在しない”)

‘列での繰り返し
For i = eZaiko.ショップ1 To eZaiko.ショップ20
‘ショップの名前
ショップ名 = tbZaiko.ListColumns(i).Name
‘ショップ名からURL変換
url_template = Application.WorksheetFunction.VLookup(ショップ名, tbURL.DataBodyRange, 2, False)
If url_template = “” Then Exit For
url = url_template & rowZaiko.Range(eZaiko.検索ワード).value
‘商品ページにアクセスする

Call ieview(objIE, url)

‘ieviewでerror_flg が経った際はIEを落とし、参照も切る
Do While error_flg = 1
Set objIE = Nothing ‘参照先のアプリケーションとの関係を切る。以降のieviewでリモートサーバーがないエラー対策
Call quitIE ‘エラーフラグが立っている場合閉じる
Call ieview(objIE, url)
Loop

‘在庫判定

If InStr(objIE.document.all(0).outerHTML, keyword) <> 0 Or InStr(objIE.document.all(0).outerHTML, keyword2) <> 0 Or InStr(objIE.document.all(0).outerHTML, keyword3) <> 0 Then
rowZaiko.Range(i).value = “〇”
rowZaiko.Range(eZaiko.在庫有無).value = “有”
flg_zaiko = 1
Exit For
Else
rowZaiko.Range(i).value = “×”
End If

Next
‘全体で在庫がない場合のみ、在庫有無に無をつける
If flg_zaiko <> 1 Then rowZaiko.Range(eZaiko.在庫有無).value = “無”
flg_zaiko = 0
Next

End Sub

‘スクリーン表示
Sub ieview(objIE As InternetExplorer, url As String)
FromTop:
error_flg = 0

On Error GoTo errorlabel1
If objIE Is Nothing Then Set objIE = getIE
If objIE.Name <> “Internet Explorer” Then Set objIE = getIE

objIE.Visible = True ‘IEを表示
objIE.navigate (url) ‘IEでURLを開く

‘読み込み処理が遅い時は一度読み込み中止し、IEを閉じる
startTime2 = Timer
Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE ‘読み込み待ち
DoEvents
endTime2 = Timer
If endTime2 – startTime2 > 10 Then GoTo error1 ‘処理時間が10秒超えた場合脱出
Loop
Exit Sub

error1:
error_flg = 1
‘ Debug.Print endTime2 – startTime2
Exit Sub

errorlabel1:
Set objIE = getIE
GoTo FromTop
End Sub

‘ IEオブジェクトを取得するなければ作成する
Public Function getIE() As Object
Dim objSh As Object
Dim objW As Object
Dim i As Integer

‘IEがすでに立ち上がっている場合はそれを活用する

Set objSh = CreateObject(“Shell.Application”)
For i = objSh.Windows.count To 1 Step -1
Set objW = objSh.Windows(i – 1)
‘ Debug.Print objW.FullName

On Error GoTo NoObject ‘objWがNothingの場合はNoObjectに遷移させて、ループ再開させる
If objW Is Nothing Then GoTo NoObject
If InStr(LCase(objW.FullName), “iexplore.exe”) <> 0 Then
On Error GoTo 0
Set getIE = objW
Exit Function
Else
NoObject:
End If
Next

‘見つからなかった場合は新規作成する
Set getIE = CreateObject(“InternetExplorer.Application”)

End Function

‘ IEオブジェクトをすべて終了させる
Public Sub quitIE()
Dim objSh As Object
Dim objW As Object
Dim i As Integer

Set objSh = CreateObject(“Shell.Application”)

For i = objSh.Windows.count To 1 Step -1
Set objW = objSh.Windows(i – 1)
If objW Is Nothing Then Exit Sub
If InStr(LCase(objW.FullName), “iexplore.exe”) > 0 Then
objW.Quit
End If
Next

End Sub