サイトの記事をエクセルに落としたいのですが・・・

質問

あるサイトの記事をエクセルに落とそうと思い、下記の様なプログラムを組んでみましたが、様々なエラーが出て、かつそのエラーがなぜ起きているのか分からない状態になってしまいました。どのように修正すればよいのか、ご存じの方がいらしたら、ぜひご教授下さい。
もしくは、もっと別のやり方で記事をエクセルに落とせる方法をご存じの方がいらしたら、ぜひご教授下さい。
大雑把な質問になってしまい、「もっと自分で考えてから質問しろ」とお叱りの言葉を頂くかと思います。私自身、なるべく色々と調べてやってきましたが一か月格闘しても遅々として進まずデッドラインが近づいてきておりまして・・・また周りにＶＢＡを知っている人が皆無という状況に耐え切れなくなり、このような質問をしてしまいました。平にご容赦下さい。
また何か補足情報が必要でしたらご遠慮なくコメントいただければと思います。よろしくお願いいたします。

Sub Macro4()
Dim URL As String 'ファイルパス
Dim IE As Object 'オブジェクト
Dim Myhtml As Variant 'HTMLタグデータ
Dim PART As String '収録されているPART
Dim TITLE As String '何話目か

Set IE = CreateObject("InternetExplorer.Application")

PART = 1
Do While PART < 2
TITLE = 0
Do While TITLE < 10

With IE
.Navigate "http://syarecowa.moo.jp/" + PART + "/" + TITLE + ".htm"
.Visible = Falese

Do While .Busy = True
DoEvents
Loop

Myhtml = IE.Document.Body.innerText
Myhtml = Replace(Myhtml, "<BR>", "")

Cells(TITLE, PART) = Myhtml
.Quit
End With

Set IE = Nothing
Loop
Loop

回答No.1

end-u · ベストアンサー

http://okwave.jp/qa/q7630144.html
の続きでしょうか。

ご提示のコードでは、
>TITLE = 0
ですから、
>Cells(TITLE, PART) = Myhtml
ここで
Cells(0, 1)...で、0行目を指定してしまってエラーになります。

だからといって、TITLE = 1　から始めればいいかというと、
"http://syarecowa.moo.jp/1/1.htm"
このURLのページは存在しませんから、目的のページを取得できません。

それに、Do Loopステートメントの中で変数 TITLE と PART を増分させてないので無限Loopです。

Excelの基本機能に[外部データの取り込み]、Webクエリというものがあります。
これを使うとWebページの取り込みができますから、操作をマクロ記録して参考にしてみてください。

実際には、前回のQAで取り込むページのリンク先URLが取得できたわけですから、
その続きで、取得したURLだけをLoop処理すれば良いです。

Sub try2()
　　Const url = "http://syarecowa.moo.jp/"
　　Dim x　 As Object
　　Dim y() As String
　　Dim i　 As Long

　　With CreateObject("InternetExplorer.Application")
　　　　.Navigate url & "menu001.htm"
　　　　.Visible = True 'False
　　　　Do While .Busy Or (.ReadyState <> 4)
　　　　　　DoEvents
　　　　Loop
　　　　'リンク先を配列に記憶
　　　　ReDim y(1 To .Document.Links.Length)
　　　　For Each x In .Document.Links
　　　　　　If x.href <> url & "menu.html" Then
　　　　　　　　i = i + 1
　　　　　　　　y(i) = x.href
　　　　　　End If
　　　　Next
　　　　.Quit
　　End With
　　'配列を有効データの個数にリサイズ
　　ReDim Preserve y(1 To i)

　　Application.ScreenUpdating = False
　　With Sheets.Add
　　　　For i = 1 To UBound(y)
　　　　　　.Cells(1, i).Value = y(i)
　　　　　　'Webクエリの繰り返し。次URLは列方向に書き出す。
　　　　　　With .QueryTables.Add(Connection:="URL;" & y(i), _
　　　　　　　　　　　　　　　　　Destination:=.Cells(2, i))
　　　　　　　　.FillAdjacentFormulas = False
　　　　　　　　.PreserveFormatting = False
　　　　　　　　.RefreshStyle = xlOverwriteCells
　　　　　　　　.AdjustColumnWidth = False
　　　　　　　　.WebSelectionType = xlEntirePage
　　　　　　　　.WebFormatting = xlWebFormattingNone
　　　　　　　　.WebPreFormattedTextToColumns = False
　　　　　　　　.WebSingleBlockTextImport = False
　　　　　　　　.WebDisableDateRecognition = True
　　　　　　　　.Refresh BackgroundQuery:=False
　　　　　　　　.Parent.Names(.Name).Delete
　　　　　　　　.Delete
　　　　　　End With
　　　　Next
　　End With
End Sub

お礼

end-u様
前回に引き続き、本当にありがとうございます。今思っている感謝は、どう言っても言葉にしつくせません。見ず知らずの私にこんなによくして下さる方がいらっしゃるとは、夢にも思いませんでした。
end-u様のマクロを実行してみて、自分の思い描いた以上の処理がババっとできた画面を見て、涙で画面がにじみました。このデータが取れなかった場合は、大幅に研究テーマを修正するしかないという瀬戸際だったものでして…

>Excelの基本機能に[外部データの取り込み]、Webクエリというものがあります。
>これを使うとWebページの取り込みができますから、操作をマクロ記録して参考にしてみてください。

ありがとうございます。Webクエリの存在自体は知りマクロなども参考にしてみたのですが、どう応用させればいいのか分からずに結局放置していました…取得したＵＲＬをWebクエリで処理すればよかったんですね。
また、ReDimの使い方も大変勉強になりました。入門編等では再定義できることのありがたみが理解できなかったので。

今回end-u様に組んでいただいたコードを勉強して、しっかりと次に活かせるように致します。また、end-u様のBLOGの方も大変参考になるものが多いので、勉強させて頂きます。

なにより、今回のend-u様のご厚意を無駄にせぬよう、精一杯研究に活かして参ります。
重ね重ね、厚く御礼申し上げます。ありがとうございました。