エクセルのWEBクリエで取り込めないデータ

質問

WEBデータをVBAで取り込みたいと思っていますが、
次のサイトをWEBクリエで取り込もうとしてもデータ内容が取り込ません。
WEBによって取り込めない場合もあるのでしょうか。
また取り込む方法は他にありますか。

※取り込みたいデータ
http://www.stardigio.com/songlists/lists1/401.html

回答No.10

DOUGLAS_

＞「’」をつけないとA4のメッセージが出てしまい実行できません。
＞つけると・・・ペーストエラー(A5)になってしまいます。
＞つまりctrl+Vで貼り付けはできる）
　ん～～。原因が分かりませんねぇ。。。

　とりあえず、
＞1chごとに新しいBookSheetに保存するので
＞chごとの呼び出しは常にA1になります。
ということですので、マクロの中で、操作の始めにＡ・Ｂ列の内容を クリア し、そこに貼り付けるようにしてみましょう。

--------------------------------------------------

　noro6857 さんは Excel2010 をお使いのようですので、「.xls」の拡張子は、「.xlsx」に変更してお試しください。

１）データ ドライブ に適当な 試験用の フォルダ を作成し、「既存の関数入りのsheet」のある ブック を コピー します。
　例えば、「D:\hoge\関数入り.xls」
２）「D:\hoge\関数入り.xls」に 標準モジュール を挿入し、下記の マクロ を コピペ します。
３）「既存の関数入りのsheet」を「Sheet1」とし、「Sheet2」のＡ列に、読み込みたい チャンネル の番号を羅列します。
　例えば、「A1:401、A2:405、A3:411、A4:456」
４）マクロ を実行します。

　その結果「D:\hoge\」フォルダ に
401Ch_(20110724) .xls
405Ch_(20110724) .xls
411Ch_(20110724) .xls
456Ch_(20110724) .xls
という４つの ブック ができます。

　マクロ の操作内容は、
１）Sheet2 の 空白セル を削除し、Ａ列 の値を配列に格納。
２）Sheet1 にて、繰り返し作業開始。
３）１チャンネルずつ、データ を読み込み、ワークシート に転記。
　存在しない チャンネル ページ を参照したときは、エラー メッセージ を表示。
４）「楽曲タイトル」と「個人的に楽しむ場合・・・」以下の２行、及び空白行を削除。
５）Sheet1 を「{チャンネル番号}Ch_{日付}.xls」という名前で、マクロブック と同じ フォルダ に保存。
以上です。

'-------------------------------------------------

Sub 繰り返し用_改訂版()
　Dim myList As Range
　Dim objIE As Object
　Dim myCh As Variant
　Dim myTbl As String
　Dim CB As New DataObject
　Application.ScreenUpdating = False
　Sheets("Sheet2").Select
　Rows(1).Insert
　Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
　Set myList = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
　Set objIE = CreateObject("InternetExplorer.Application")
　With objIE
　　Sheets("Sheet1").Select
　　For myCh = 1 To myList.Count
　　　Application.StatusBar = myList(myCh) & "チャンネルを読み込んでいます。"
　　　.Navigate "http://www.stardigio.com/songlists/lists1/" & myList(myCh) & ".html"
　　　Application.Wait (Now + TimeValue("0:00:05"))
　　　If InStr(.Document.body.outerHTML, "このサイトの中には見つかりませんでした") > 0 Then
　　　　MsgBox myList(myCh) & "チャンネルのページは見つかりませんでした。"
　　　Else
　　　　myTbl = objIE.Document.getElementsByName("SongLists")(0).outerHTML
　　　　Columns("A:B").Clear
　　　　With CB
　　　　　.SetText myTbl
　　　　　.PutInClipboard
　　　　　.GetFromClipboard
　　　　End With
　　　　Range("A1").Select
　　　　ActiveSheet.Paste
　　　　Columns("A:A").Replace "楽曲タイトル", ""
　　　　On Error Resume Next
　　　　Columns("A:A").Find("個人的に楽しむ場合を除き").Resize(2).Clear
　　　　On Error GoTo 0
　　　　Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
　　　　Range("A1").Select
　　　　Sheets("Sheet1").Copy
　　　　ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & myList(myCh) & "Ch_(" & Replace(Date, "/", "") & ") .xls"
　　　　ActiveWorkbook.Close
　　　End If
　　Next
　　Application.StatusBar = ""
　　.Quit
　　Columns("A:B").Clear
　End With
　Set objIE = Nothing
　Application.ScreenUpdating = True
End Sub

'-------------------------------------------------

　上記の マクロ は、チャンネル ごとに新しい ブック に保存するようにしていますが、１つの ブック に、チャンネル ごとに、新しい シート を追加する、という意味でしたら、変数の宣言部に
Dim newBook As Workbook
を追加し、

'-------------------------------------------------
　　　　Sheets("Sheet1").Copy
　　　　ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & myList(myCh) & "Ch_(" & Replace(Date, "/", "") & ") .xls"
　　　　ActiveWorkbook.Close
　　　End If
　　Next
'-------------------------------------------------

の部分を

'-------------------------------------------------
　　　　If myCh = 1 Then
　　　　　ThisWorkbook.Sheets("Sheet1").Copy
　　　　　ActiveSheet.Name = myList(myCh) & "Ch"
　　　　　ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Replace(Date, "/", "") & ".xls"
　　　　　Set newBook = ActiveWorkbook
　　　　Else
　　　　　ThisWorkbook.Sheets("Sheet1").Copy After:=newBook.Sheets(newBook.Sheets.Count)
　　　　　ActiveSheet.Name = myList(myCh) & "Ch"
　　　　　ThisWorkbook.Activate
　　　　End If
　　　End If
　　Next
　　newBook.Activate
　　Sheets(1).Select
　　ActiveWorkbook.Save
　　ActiveWorkbook.Close
'-------------------------------------------------

に差し替えてお試しください。

　この場合は、「D:\hoge\」フォルダ に
20110724 .xls
という ブック ができて、その ブック には、
401Ch、405Ch、411Ch、456Ch
という４つの シート ができます。

お礼

きのう回答を書き込んだつもりでしたが、入力し忘れたようで失礼しました。

この方法だと一気にできてしまうのですね。
毎週同じチャンネルの選択なので、一度必要チャンネルを入力しておけばいちいち一つずつ入力手間がかからずこれなら重宝します。
ということで早速試してみました。
（Book単位での作成なので前段のマクロを使いました）

２０１０のマクロ有効ファイルはxlsxでなくxlsmでしたのでその拡張子で試しました。
ただ、出来上がりがどうも安定しなくて、ひとつも生成されずにペーストエラーになったり、１０くらい指定するうちの５つくらいでとまったり、もちろん全部作られるときもありました。（STOPはいずれもペーストできないとのメッセージ）
この因果関係はよくつかめません。
今朝再度トライしてみたらすべてのファィルが生成されました。理由はよくわかりません。
削除行はうまく処理されていました。特に途中の空白行も削除できたらと思っていましたのでこれも削除されていていい仕上がりになりました。
ただし、ひとつだけ問題が。
関数式の入っているブックに取り込んでいるのですが、その関数式が
ひとつめのブックでは問題ないのですが、ふたつめ、みっつめと進むうちに下の方からだんだん式が削除されてしまい、１０こめのBookでは１行目の式しか残っていませんでした。

あと生成されるシートはxlsで作られるため、出来上がりを開くときにその都度メッセージが「開こうとしているファイルが実際はその拡張子が示すファイル形式ではありません。コノファィルを開く前に、ファイルが破損していないこと、信頼できる発行元のファイルであることを確認してください」と出て、かまわずそのまま開けば取り込まれたファイルであることには変わりません。これはメッセージがわずらわしいだけで問題はありません。