ホームページからISBNコードを抜き出し検索したい

質問

ブックオフオンラインYahoo!店の検索結果の書籍の個別ページ
例えば、

中古 サウスポー・キラー 宝島社文庫／水原秀策【著】
JANコード/ISBNコード：9784796656719

レビューを投稿する
価格 200円 （税込）

https://store.shopping.yahoo.co.jp/bookoffonline/0015509916.html

からISBNコードの番号
9784796656719

を抜き出してそのコードをAmazonで検索するには
どうすればいいですか？

一番簡単に実行するにはどうすればいいでしょうか？

ブックオフオンラインYahoo!店で沢山本を検索して検索した書籍のISBNコードを
Amazonで検索することが多いので、

どうすれば、簡単出来るかしりたいです。

アドバイス頂けると幸いです
よろしくおねがいします。(・´з`・)

回答No.4

HohoPapa · ベストアンサー

uu2020さんのアドバイスを受け
APIを使うのをやめてみました。

以下で試してみてください。

Option Explicit

　'以下を参照設定
　'・Microsoft HTML Object Library
　'・Microsoft Internet Controls
　'参考：https://www.vba-ie.net/library/

'Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

'メイン処理
Sub Main()
　Dim RowCnt As Long

　With ThisWorkbook.Sheets(1)
　　RowCnt = 2
　　Do
　　　If .Cells(RowCnt, 1).Value = "" Then Exit Do
　　　.Cells(RowCnt, 2).NumberFormatLocal = "@"
　　　.Cells(RowCnt, 2).Value = GetISBN(.Cells(RowCnt, 1).Value)
　　　RowCnt = RowCnt + 1
　　Loop
　End With

　amazonSearch2

End Sub

Function GetISBN(MyUrl As String) As String

　Const WTime = 5　 'IE描写完了までの待ち時間(秒)
　Dim objIE As InternetExplorer
　Dim SPos As Long
　Dim EPos As Long
　Dim MyText As String
　Dim SearchKey As String
　Dim I As Long
　Dim ISBN As String

　GetISBN = ""

　SearchKey = "JANコード/ISBNコード："

　Set objIE = CreateObject("InternetExplorer.Application")
　objIE.Visible = True
　objIE.navigate MyUrl
　Call IEWait(objIE)　 'IEを待機
　Call WaitFor(WTime)　'描写完了待ち

　'Form_Sauce.TBox_Sauce.Text = objIE.document.body.innerText
　MyText = objIE.document.body.innerText
　SPos = InStr(MyText, "JANコード/ISBNコード：")
　If SPos = 0 Then
　　GetISBN = "?"
　　objIE.Quit
　　Exit Function
　End If
　objIE.Quit

　ISBN = Mid(MyText, SPos + Len(SearchKey), 18)
　EPos = InStr(ISBN, vbCrLf)
　'ISBN = Mid(MyText, SPos + Len(SearchKey), EPos - 1)
　ISBN = Left(ISBN, EPos - 1)

　GetISBN = ISBN

　Set objIE = Nothing

End Function

'IE、urlへのアクセス完了を待機---
Function IEWait(ByRef objIE As Object)
　Do While objIE.Busy = True Or objIE.readyState <> 4
　　　DoEvents
　Loop
End Function

'--指定した秒だけ停止---
Function WaitFor(ByVal second As Integer)
　Dim futureTime As Date
　futureTime = DateAdd("s", second, Now)
　While Now < futureTime
　　DoEvents
　Wend
End Function

'amazonを検索
'https://rikei-fufu.com/2019/10/07/post-2149-vba-amazon/
Sub amazonSearch2()
　Dim searchWord As String
　Dim azUrl As String　'URL
　Dim azName As String '商品名
　Dim azValue As String '価格

　Dim ws As Worksheet
　Dim erow As Integer
　Dim irow As Integer

　erow = Cells(Rows.Count, 2).End(xlUp).Row
　Set ws = ActiveSheet

　Dim ie As InternetExplorer
　Dim html As HTMLDocument

　Set ie = CreateObject("Internetexplorer.Application")
'　　ie.Visible = True

　For irow = 2 To erow

　　If ((ws.Cells(irow, 2).Value <> "") And (ws.Cells(irow, 2).Value <> "?")) Then
　　　ie.navigate ("https://www.amazon.co.jp/")

　　　Do While ie.Busy = True Or ie.readyState < 4
　　　　　　DoEvents
　　　Loop
　　　Set html = ie.document

　　　Dim searchForm As HTMLInputTextElement
　　　Set searchForm = html.getElementById("twotabsearchtextbox")
　　　searchForm.Value = ws.Cells(irow, 2)

　　　Dim btnSearch As HTMLFormElement
　　　Set btnSearch = html.getElementsByClassName("nav-input")(0)
　　　btnSearch.Click

　　　Do While ie.Busy = True Or ie.readyState < 4
　　　　DoEvents
　　　Loop

　　　WaitFor (3) '3秒まつ　javascriptを待つため
　　　azName = html.getElementsByClassName("a-size-base-plus a-color-base a-text-normal")(0).innerText
　　　ws.Cells(irow, 3) = azName
　　　azValue = html.getElementsByClassName("a-price-whole")(0).innerText
　　　ws.Cells(irow, 4) = azValue

'　　　　Dim elm As Object
'　　　　Set elm = html.getElementsByClassName("a-size-base a-link-normal s-no-hover a-text-normal")(0)
'　　　　'azUrl = elm.href
'　　　　ws.Cells(irow, 5) = azUrl
　　End If
　Next irow

　Set html = Nothing
　'Set searchFom = Nothing
　Set btnSearch = Nothing
　'Set link = Nothing
　Set ie = Nothing
　Set ws = Nothing

End Sub

お礼

回答ありがとうございます。
回答頂いた、プログラムを

参照設定を確認して実行したところ、

オブジェクト変数またはwithブロック変数がせっていされていません。

と出て
ブックオフオンラインの適当なURL
https://store.shopping.yahoo.co.jp/bookoffonline/0012330049.html

で試したところ、
ISBNコードと書籍名を取り込んだところでストップしました。

回答No.7

HohoPapa

>警告のエラー表示はOKを押せるだけで、
>それを消した後の画面に黄色い場所はない感じです。

ごめんなさい、当方ではエラーを再現できず、
適切なアドバイスができません。
当方の環境は
Windows10_64ビット＋Office2019_32ビットです。
Officeの64ビット環境は手元になく、
もし、この差が原因であれば、手に負えません。

他に
Office2013、Office365、Office2010の環境があるので、
（全数32ビットです）
時間があるときに確認してみますが
期待しないでください。

私は、
http://itsupport.cbit.co.jp/archives/245
にも説明がありますが、
64ビットには扱えない機能があるので、64ビット版は使いません。

お礼

回答ありがとうございます。

VBEの画面を表示、メニューから「ツール」「オプション」「全般」に進んで、設定を変えたところ、

プログラム実行後にエラーで止まったあと

「デバッグ」を選べるようになりました。

１３４行目の

azValue = html.getElementsByClassName("a-price-whole")(0).innerText

が黄色くなりました。

お忙しい所、自分の理解不足のためお手間をとらせて
すみませんでした。

大変申し訳ございませんが、よろしくお願いいたします。

補足

OSのバージョンとエクセルのバージョンを確認したところ

Windows10 Home 64ビット
Excel2016の32ビット

でした。

回答No.6

HohoPapa

＞回答ありがとうございます。９１行目のようです。
91行目は、
Dim searchWord As String
の行であり、エラーになる行とは考えにくいです。

>オブジェクト変数またはwithブロック変数がせっていされていません。
>と出て
この画面でデバックを選ぶと、どこかの行が黄色の表示になるはずです。
それがどの行なのかを示してほしいのです。

お礼

回答ありがとうございます
Windows10でExcel2016を使っています

プログラムを実行してエラーが出て止まった画面で

警告のエラー表示はOKを押せるだけで、
それを消した後の画面に黄色い場所はない感じです。

VBA デバッグの仕方
https://www.tipsfound.com/vba/01010

を見ながらいろいろやってみると９１行目で同じエラーメッセージの文章が
表示されますが、黄色くなる部分はないです。

APIを呼び出して使っていた
Sleep (1000) '1秒まつ　javascriptを待つため

を
WaitFor (3) '3秒まつ　javascriptを待つため
に修正頂いた方で実行したかどうかも確認しましたが
ダメでした。

参照設定もしてあります。

大変申し訳ございませんが、よろしくお願いします。

回答No.5

HohoPapa

>オブジェクト変数またはwithブロック変数がせっていされていません。
>と出て
この画面でデバックを選ぶと、どこかの行が黄色の表示になるはずです。
それがどの行なのかを示してほしいのです。

お礼

回答ありがとうございます。９１行目のようです。
プログラムを実行してエラーが出たあと
ステップインというのでプログラムに入って調べたところ９１行目とでました。

回答No.3

uu2020

エクセルVBAの実行時「実行時エラー ‘424’: オブジェクトが必要です。」への回答です。
参照設定は、設定済みでしょうか？
もう一つ、
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
64bitEXCEL（vba）で動かすためには、API宣言を変えないとダメです。
「 Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)　64bit」で検索してみてください。

お礼

回答ありがとうございます。
参照設定はしてあります。

https://www.saka-en.com/office/vba-declare-statement-update-excel-2013/

具体的な変更例
よく使われる Sleep を例にあげてみます。32 ビット版では、以下のように記述していました。

1
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
64 ビット版では、Declare の後ろにPtrSafeを付加します。

1
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
すべての Declare ステートメントにPtrSafeを付加したら、メニューの「デバッグ」から「VBAProjectのコンパイル」を実行してみましょう。エラーが出なくなるはずです。

上記などを参考にグーグルで調べて、

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

のところを

#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

に変えてみたのですが、
実行時エラー'91':
オブジェクト変数またはWithブロック変数がしていされていません。

と出てダメでした。

回答No.2

HohoPapa

50行目
　'Form_Sauce.TBox_Sauce.Text = objIE.document.body.innerText　
をコメントアウトしてください。
そもそもデバック用で無用です。　m(_ _)m

　'以下を参照設定
　'・Microsoft HTML Object Library
　'・Microsoft Internet Controls
　'参考：https://www.vba-ie.net/library/
これは設定していますね？

それ以上は思いつきません。
なおエラーなら
どの行でエラーなのかを教えてください。

Option Explicit

　'以下を参照設定
　'・Microsoft HTML Object Library
　'・Microsoft Internet Controls
　'参考：https://www.vba-ie.net/library/

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

'メイン処理
Sub Main()
　Dim RowCnt As Long

　With ThisWorkbook.Sheets(1)
　　RowCnt = 2
　　Do
　　　If .Cells(RowCnt, 1).Value = "" Then Exit Do
　　　.Cells(RowCnt, 2).NumberFormatLocal = "@"
　　　.Cells(RowCnt, 2).Value = GetISBN(.Cells(RowCnt, 1).Value)
　　　RowCnt = RowCnt + 1
　　Loop
　End With

　amazonSearch2

End Sub

Function GetISBN(MyUrl As String) As String

　Const WTime = 5　 'IE描写完了までの待ち時間(秒)
　Dim objIE As InternetExplorer
　Dim SPos As Long
　Dim EPos As Long
　Dim MyText As String
　Dim SearchKey As String
　Dim I As Long
　Dim ISBN As String

　GetISBN = ""

　SearchKey = "JANコード/ISBNコード："

　Set objIE = CreateObject("InternetExplorer.Application")
　objIE.Visible = True
　objIE.navigate MyUrl
　Call IEWait(objIE)　 'IEを待機
　Call WaitFor(WTime)　'描写完了待ち

　'Form_Sauce.TBox_Sauce.Text = objIE.document.body.innerText　　'<==コメントアウト
　MyText = objIE.document.body.innerText
　SPos = InStr(MyText, "JANコード/ISBNコード：")
　If SPos = 0 Then
　　GetISBN = "?"
　　objIE.Quit
　　Exit Function
　End If
　objIE.Quit

　ISBN = Mid(MyText, SPos + Len(SearchKey), 18)
　EPos = InStr(ISBN, vbCrLf)
　'ISBN = Mid(MyText, SPos + Len(SearchKey), EPos - 1)
　ISBN = Left(ISBN, EPos - 1)

　GetISBN = ISBN

　Set objIE = Nothing

End Function

'IE、urlへのアクセス完了を待機---
Function IEWait(ByRef objIE As Object)
　Do While objIE.Busy = True Or objIE.readyState <> 4
　　　DoEvents
　Loop
End Function

'--指定した秒だけ停止---
Function WaitFor(ByVal second As Integer)
　Dim futureTime As Date
　futureTime = DateAdd("s", second, Now)
　While Now < futureTime
　　DoEvents
　Wend
End Function

'amazonを検索
'https://rikei-fufu.com/2019/10/07/post-2149-vba-amazon/
Sub amazonSearch2()
　Dim searchWord As String
　Dim azUrl As String　'URL
　Dim azName As String '商品名
　Dim azValue As String '価格

　Dim ws As Worksheet
　Dim erow As Integer
　Dim irow As Integer

　erow = Cells(Rows.Count, 2).End(xlUp).Row
　Set ws = ActiveSheet

　Dim ie As InternetExplorer
　Dim html As HTMLDocument

　Set ie = CreateObject("Internetexplorer.Application")
'　　ie.Visible = True

　For irow = 2 To erow

　　If ((ws.Cells(irow, 2).Value <> "") And (ws.Cells(irow, 2).Value <> "?")) Then
　　　ie.navigate ("https://www.amazon.co.jp/")

　　　Do While ie.Busy = True Or ie.readyState < 4
　　　　　　DoEvents
　　　Loop
　　　Set html = ie.document

　　　Dim searchForm As HTMLInputTextElement
　　　Set searchForm = html.getElementById("twotabsearchtextbox")
　　　searchForm.Value = ws.Cells(irow, 2)

　　　Dim btnSearch As HTMLFormElement
　　　Set btnSearch = html.getElementsByClassName("nav-input")(0)
　　　btnSearch.Click

　　　Do While ie.Busy = True Or ie.readyState < 4
　　　　DoEvents
　　　Loop

　　　Sleep (1000) '1秒まつ　javascriptを待つため
　　　azName = html.getElementsByClassName("a-size-base-plus a-color-base a-text-normal")(0).innerText
　　　ws.Cells(irow, 3) = azName
　　　azValue = html.getElementsByClassName("a-price-whole")(0).innerText
　　　ws.Cells(irow, 4) = azValue

'　　　　Dim elm As Object
'　　　　Set elm = html.getElementsByClassName("a-size-base a-link-normal s-no-hover a-text-normal")(0)
'　　　　'azUrl = elm.href
'　　　　ws.Cells(irow, 5) = azUrl
　　End If
　Next irow

　Set html = Nothing
　'Set searchFom = Nothing
　Set btnSearch = Nothing
　'Set link = Nothing
　Set ie = Nothing
　Set ws = Nothing

End Sub

お礼

回答ありがとうございます。
ISBNが取得できました。(・´з`・)

ISBN取得後、

実行時エラー'91';　オブジェクト変数またはWithブロックが設定されていません。

というエラーがでてストップしてしまいました。
お忙しいところ何度も質問して申し訳ございませんがよろしくおねがいします。

回答No.1

HohoPapa

指定されたurlからＩＳＢＮを求め、
そのISBNでAmazonを検索し、
書籍名と価格を取得する。
という理解でいいでしょうか？

興味を惹かれ、エクセルVBAで作成してみました。

よかったら、添付画像と以下のコードを参考に
挑戦してみてください。（若干手抜きです）

Option Explicit

　'以下を参照設定
　'・Microsoft HTML Object Library
　'・Microsoft Internet Controls
　'参考：https://www.vba-ie.net/library/

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

'メイン処理
Sub Main()
　Dim RowCnt As Long

　With ThisWorkbook.Sheets(1)
　　RowCnt = 2
　　Do
　　　If .Cells(RowCnt, 1).Value = "" Then Exit Do
　　　.Cells(RowCnt, 2).NumberFormatLocal = "@"
　　　.Cells(RowCnt, 2).Value = GetISBN(.Cells(RowCnt, 1).Value)
　　　RowCnt = RowCnt + 1
　　Loop
　End With

　amazonSearch2

End Sub

Function GetISBN(MyUrl As String) As String

　Const WTime = 5　 'IE描写完了までの待ち時間(秒)
　Dim objIE As InternetExplorer
　Dim SPos As Long
　Dim EPos As Long
　Dim MyText As String
　Dim SearchKey As String
　Dim I As Long
　Dim ISBN As String

　GetISBN = ""

　SearchKey = "JANコード/ISBNコード："

　Set objIE = CreateObject("InternetExplorer.Application")
　objIE.Visible = True
　objIE.navigate MyUrl
　Call IEWait(objIE)　 'IEを待機
　Call WaitFor(WTime)　'描写完了待ち

　Form_Sauce.TBox_Sauce.Text = objIE.document.body.innerText
　MyText = objIE.document.body.innerText
　SPos = InStr(MyText, "JANコード/ISBNコード：")
　If SPos = 0 Then
　　GetISBN = "?"
　　objIE.Quit
　　Exit Function
　End If
　objIE.Quit

　ISBN = Mid(MyText, SPos + Len(SearchKey), 18)
　EPos = InStr(ISBN, vbCrLf)
　'ISBN = Mid(MyText, SPos + Len(SearchKey), EPos - 1)
　ISBN = Left(ISBN, EPos - 1)

　GetISBN = ISBN

　Set objIE = Nothing

End Function

'IE、urlへのアクセス完了を待機---
Function IEWait(ByRef objIE As Object)
　Do While objIE.Busy = True Or objIE.readyState <> 4
　　　DoEvents
　Loop
End Function

'--指定した秒だけ停止---
Function WaitFor(ByVal second As Integer)
　Dim futureTime As Date
　futureTime = DateAdd("s", second, Now)
　While Now < futureTime
　　DoEvents
　Wend
End Function

'amazonを検索
'https://rikei-fufu.com/2019/10/07/post-2149-vba-amazon/
Sub amazonSearch2()
　Dim searchWord As String
　Dim azUrl As String　'URL
　Dim azName As String '商品名
　Dim azValue As String '価格

　Dim ws As Worksheet
　Dim erow As Integer
　Dim irow As Integer

　erow = Cells(Rows.Count, 2).End(xlUp).Row
　Set ws = ActiveSheet

　Dim ie As InternetExplorer
　Dim html As HTMLDocument

　Set ie = CreateObject("Internetexplorer.Application")
'　　ie.Visible = True

　For irow = 2 To erow

　　If ((ws.Cells(irow, 2).Value <> "") And (ws.Cells(irow, 2).Value <> "?")) Then
　　　ie.navigate ("https://www.amazon.co.jp/")

　　　Do While ie.Busy = True Or ie.readyState < 4
　　　　　　DoEvents
　　　Loop
　　　Set html = ie.document

　　　Dim searchForm As HTMLInputTextElement
　　　Set searchForm = html.getElementById("twotabsearchtextbox")
　　　searchForm.Value = ws.Cells(irow, 2)

　　　Dim btnSearch As HTMLFormElement
　　　Set btnSearch = html.getElementsByClassName("nav-input")(0)
　　　btnSearch.Click

　　　Do While ie.Busy = True Or ie.readyState < 4
　　　　DoEvents
　　　Loop

　　　Sleep (1000) '1秒まつ　javascriptを待つため
　　　azName = html.getElementsByClassName("a-size-base-plus a-color-base a-text-normal")(0).innerText
　　　ws.Cells(irow, 3) = azName
　　　azValue = html.getElementsByClassName("a-price-whole")(0).innerText
　　　ws.Cells(irow, 4) = azValue

'　　　　Dim elm As Object
'　　　　Set elm = html.getElementsByClassName("a-size-base a-link-normal s-no-hover a-text-normal")(0)
'　　　　'azUrl = elm.href
'　　　　ws.Cells(irow, 5) = azUrl
　　End If
　Next irow

　Set html = Nothing
　'Set searchFom = Nothing
　Set btnSearch = Nothing
　'Set link = Nothing
　Set ie = Nothing
　Set ws = Nothing

End Sub

お礼

回答ありがとうございます。勉強になりました。(・´з`・)

ブックオフで検索した書籍をなぜAmazonで検索したかったか？
というと実は、グーグルクロームのアドオンで

Calilay
https://sites.google.com/site/calilay/

というのがあり、このアドオンは指定した公立図書館など５か所に
Amazonで検索した書籍があるか表示できるからです。

これにより、自分でブックオフにある書籍が図書館にあるかどうか調べるプログラム組むより
簡単に、ブックオフにある書籍が図書館にあるかどうか調べられる環境構築できると
考えました。(・´з`・)

教えて頂いた、ISBNの抽出に関するVBAのコードを参考にしてみます。

調べたらブラウザを立ち上げて、セルの値を検索するというのも
のっていたのでその方法を使い、

考えてみようと思います。(・´з`・)

セルの値を好きなブラウザでGoogle検索する
https://vbabeginner.net/%E3%82%BB%E3%83%AB%E3%81%AE%E5%80%A4%E3%82%92%E5%A5%BD%E3%81%8D%E3%81%AA%E3%83%96%E3%83%A9%E3%82%A6%E3%82%B6%E3%81%A7google%E6%A4%9C%E7%B4%A2%E3%81%99%E3%82%8B/

【ExcelVBA】セルの中身でブラウザ検索するコード例【マクロ】
2019.03.16 2019.03.07
セルを選んでポチッと検索したい！
https://srbrnote.work/archives/2594

補足

(｀・ω・´)　お忙しいところ失礼します。追加で質問があります。

回答頂いたVBAのプログラムを実行したところ、

オブジェクトが必要です

と出て実行できません。（；；）

エクセルVBAの実行時「実行時エラー ‘424’: オブジェクトが必要です。」
が出る原因と回避方法
https://web.plus-idea.net/biz/excel-vba-error-object-required/

【ExcelVBA入門】「オブジェクトが必要です」のエラー原因・対処方法とは
https://www.sejuku.net/blog/69046

これを読んだのですが、どこを直せばよいか分からず、悩んでます。
もし、回答頂けたらアドバイスよろしくお願いします。