こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

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

レビューを投稿する
価格 200円 (税込)

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

からISBNコードの番号
9784796656719

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

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

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

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

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

投稿日時 - 2020-07-25 13:38:29

QNo.9777240

困ってます

質問者が選んだベストアンサー

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

投稿日時 - 2020-07-26 20:16:39

お礼

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

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

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

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

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

投稿日時 - 2020-07-26 20:59:16

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(7)

ANo.7

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

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


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

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

投稿日時 - 2020-07-27 23:02:37

補足

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

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

でした。

投稿日時 - 2020-07-28 21:55:01

お礼

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

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

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

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

134行目の

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

が黄色くなりました。

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

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

投稿日時 - 2020-07-28 23:13:46

ANo.6

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

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

投稿日時 - 2020-07-26 22:21:25

お礼

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

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

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

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

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

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


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

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

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

投稿日時 - 2020-07-27 00:09:51

ANo.5

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

投稿日時 - 2020-07-26 21:19:14

お礼

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

投稿日時 - 2020-07-26 21:54:04

ANo.3

エクセル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」で検索してみてください。

投稿日時 - 2020-07-26 19:12:37

お礼

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


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ブロック変数がしていされていません。

と出てダメでした。

投稿日時 - 2020-07-26 21:12:42

ANo.2

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

投稿日時 - 2020-07-26 18:08:56

お礼

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

ISBN取得後、

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

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

投稿日時 - 2020-07-26 18:37:03

ANo.1

指定されたurlからISBNを求め、
その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

投稿日時 - 2020-07-26 13:05:31

補足

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

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

オブジェクトが必要です

と出て実行できません。(;;)


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

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

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

投稿日時 - 2020-07-26 17:22:29

お礼

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

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

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

というのがあり、このアドオンは指定した公立図書館など5か所に
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

投稿日時 - 2020-07-26 16:11:01

あなたにオススメの質問