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

質問

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

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

回答No.14

DOUGLAS_

＞ただ過去のデータで・・記述がたくさんあったため
＞万一あったときのための気休め程度の存在です。
と心配していらっしゃいますが、恐らく、そういうことはご心配要らないかと存じます。

　と申すよりは、こういう「ＷＥＢデータ の取り込み」においては、その ＷＥＢページ の作りに合わせて、取り込み側で逐一方法を考え、サイト側 で サイト の作りを変更したような場合には、方法を考え直すのが常道かと存じますし、まして、過去の サイト構成 データ を取り込むための「計算式」を温存しておく意味は皆無かと存じます。

　従いまして、今般読み込んでいる サイト の冒頭の２行
Ch.４０１ Ｊ－ＰＯＰ最新ヒットチャート
放送日 ： ２０１１／７／２５～２０１１／７／３１ 「番組案内　（４時間サイクル）」
から「■110725SD401」を生成するだけでよろしいのでしたら、全部の行に、その「計算式」を挿入する必要は全くなく（サイト の構成を私が検証いたしました）、マクロ の中で、冒頭の２行を「■110725SD401」というように変えてしまえばよいかと存じます。

　そういう理解でよろしいでしょうか？【問18】
　もし、まだ、不安が残るようでしたら、冒頭の成形作業は、「繰り返し用_改訂版」のままで、マクロ には入れないことにいたしますので、文末の「テスト３」をお試しいただいてから、成形作業を マクロ に入れるか入れないかをお返事ください。【問19】

　また、入れる場合、この文字列の間にある「SD」は、すべての ページ で「SD」のままでよろしいでしょうか？【問20】

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

＞Lotusの方は２種類つくっていてChによって使い分けています。
　詳しくご説明いただいてよく分かりました。

＞説明するのにシートを直接見
なければ分かりそうにもありませんので、【問16】の方は、無かったことにさせてください。
　却って無駄な時間を費やさせてしまいまして、誠に申し訳ございませんでした。　　<(_ _)>

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

＞問１７　xlsの場合
こちらは必要ありません。

＞標準のxlsxを使用した場合、保存の段階で
＞次の機能はマクロなしのブックに保存できません
　これは、保存しようとしている 新規ブック で「新しいマクロの記録」をされたからです。別の ブック に記録すれば、この エラー は出ないと存じます。

　「ANo.10」の「お礼」に書いていらっしゃった
＞開こうとしているファイルが実際はその
＞拡張子が示すファイル形式ではありません。
の メッセージ につきましては、
http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200901/09010064.txt
を拝見して、大体予想通りだと思われました。

　つまり、「xls」で保存すると「FileFormat」が「xlExcel8」となり、
Filename:="D:\Book1.xls", FileFormat:=xlExcel8
「xlsx」で保存すると「FileFormat」が「xlOpenXMLWorkbook」となっているようですので、
Filename:="D:\Book1.xlsx", FileFormat:= xlOpenXMLWorkbook

　従いまして、「ANo.10」に書きましたように、
＞「.xls」の拡張子は、「.xlsx」に変更
するだけで行けるはずです。

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

　さて、最後になりましたが、恐らく、これが最後の テスト になるかと存じます。
　401チャンネル を開いて、ワークシート に展開する マクロ ですが、<<< 新規の ブック に 標準モジュール を挿入して >>> お試しいただいて、上記の質問にお答えください。

　なお、冒頭の２行は、
■110725SD401 「番組案内　（４時間サイクル）」
にまとめました。

'-------------------------------------------------
Sub テスト3()
　Dim objHttp As Object
　Dim myTbl As Variant
　Dim CB As New DataObject
　Sheets("Sheet1").Select
　Set objHttp = CreateObject("MSXML2.XMLHTTP")
　With objHttp
　　.Open "GET", "http://www.stardigio.com/songlists/txtdata/lists1/401.txt", False
　　.Send
　　myTbl = .responseText
　　myTbl = Split(myTbl, "放送日")
　　myTbl(0) = Left(myTbl(1), InStr(myTbl(1), "～"))
　　myTbl(0) = Trim(Replace(Replace(StrConv(myTbl(0), vbNarrow), ":", ""), "~", ""))
　　myTbl(0) = Format(myTbl(0), "yymmdd")
　　myTbl(0) = "■" & myTbl(0) & "SD401"
　　With CB
　　　.SetText myTbl(0) & Mid(myTbl(1), InStr(myTbl(1), vbTab))
　　　.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
　　Columns("A:B").Columns.AutoFit
　　Range("A1:B1").Select
　　ActiveWindow.Zoom = True
　　Range("A1").Select
　End With
　Set objHttp = Nothing
End Sub

お礼

今度のテストは呼び込みがおっそろしく早いですねぇ!
これはばっちりでした。
関数についてはご指示どおり排除してけっこうです。

問１８／問１９
１行目を
■110725SD401に変えていただければけっこうです。
※なお、今頃気がついたのですが、開始時間の行は削除対象のものでした。
したがって上記は１行目だけでかまいません。

問２０
日付の次はすべてSD（半角）になります。

これはVBAの中にチャンネル番号が記述されていますが、実際には前回のような連続もしくはテキストボックスの数値を当てはめることになるのですね

あと、前回以来せっかくご指導いただく機会ができたので、前回の分について、サイト名（記述式）が変更になってしまったのでここで修正の方法をお願いしてよろしいでしょうか。
後に別の方に別のVBAを教えていただきましたが、最近文字化けが発生することが多いのでやや困っていました。