Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


5913 / 13645 ツリー ←次へ | 前へ→

【48199】vbaであるホームページの特定部分をコピーできるのでしょうか? はる 07/4/7(土) 23:31 質問[未読]
【48202】質問をわかりやすく追加します はる 07/4/7(土) 23:53 質問[未読]
【48206】Re:質問をわかりやすく追加します ぱっせんじゃー 07/4/8(日) 9:02 発言[未読]
【48210】Re:質問をわかりやすく追加します ichinose 07/4/8(日) 16:24 発言[未読]
【48249】Re:質問をわかりやすく追加します はる 07/4/10(火) 0:25 お礼[未読]
【48252】Re:質問をわかりやすく追加します ichinose 07/4/10(火) 8:53 発言[未読]

【48199】vbaであるホームページの特定部分をコピ...
質問  はる  - 07/4/7(土) 23:31 -

引用なし
パスワード
   エクセルからホームページを開き
ある特定の
例 <div class="content1">
のtext内容だけをコピーして
エクセルにペイストしたいのです.
ホームページ上の特定部分のコピー
などvbaからできるでしょうか?
ホームページ上の特定部分といっても
オブジェクト名みたいなものがないといけないし・・・

【48202】質問をわかりやすく追加します
質問  はる  - 07/4/7(土) 23:53 -

引用なし
パスワード
   質問内容がアバウトすぎたので追加させてください
ここのホームページで
xxxxxxx.vbalab.xxx/vbaqa/c-board.cgi?cmd=one;no=48199;id=excel
のアドレスの48199を48198
などにして
表示される質問のテキスト部分だけを
次々にコピーしてエクセルに貼り付けたいのです
エクセルには
48198
48199
のようにデータを入れておいて
アクティブセルを下に1つずつ移動する中に
アドレスを作り ホームページを開き 質問をコピーし エクセルにペイスト
アクティブセルを下に1つずつ移動
としたいのですが

これと同じようなことを会社の仕事で実行したく・・・
どうぞ宜しくお願いします

【48206】Re:質問をわかりやすく追加します
発言  ぱっせんじゃー  - 07/4/8(日) 9:02 -

引用なし
パスワード
   >これと同じようなことを会社の仕事で実行したく・・・

サイトによって出来ないかもしれませんが、
WEBクエリ
を使う、ではダメですか?

【48210】Re:質問をわかりやすく追加します
発言  ichinose  - 07/4/8(日) 16:24 -

引用なし
パスワード
   こんにちは。

>質問内容がアバウトすぎたので追加させてください
>ここのホームページで
>xxxxxxx.vbalab.xxx/vbaqa/c-board.cgi?cmd=one;no=48199;id=excel
>のアドレスの48199を48198
>などにして
>表示される質問のテキスト部分だけを
>次々にコピーしてエクセルに貼り付けたいのです
>エクセルには
>48198
>48199
>のようにデータを入れておいて
>アクティブセルを下に1つずつ移動する中に
>アドレスを作り ホームページを開き 質問をコピーし エクセルにペイスト
>アクティブセルを下に1つずつ移動
>としたいのですが
>
>これと同じようなことを会社の仕事で実行したく・・・
>どうぞ宜しくお願いします



新規ブックの標準モジュールに
'===========================================================
Public Declare Function ShowWindow Lib "user32" (ByVal hwindow As Long, ByVal cmdshow As Long) As Long
'======================================================================
Sub main()
  Dim IE
  Dim idoc
  Set IE = CreateObject("InternetExplorer.Application")
  With IE
    .Visible = True
    ShowWindow .Hwnd, 3
    .navigate "HTTP://www.vbalab.net/vbaqa/c-board.cgi?id=excel"
'         実際には↑のHTTPを半角小文字に訂正してください
    Do While .Busy = True Or .readyState <> 4
     Loop
    Set idoc = .document
    On Error Resume Next
    With idoc
     .forms(0).all("no").Value = "48199"
     .forms(0).submit
     End With
    Do While .Busy = True Or .readyState <> 4
     Loop
    Set idoc = .document
    AppActivate Application.Caption
    With idoc
     MsgBox .all(76).innertext 'これは全部のエレメントを調べた結果
     MsgBox .all(145).innertext 'このインデックスでタイトルと本文
                   'が取得できました
     End With
    Set idoc = Nothing
    .Quit
    On Error GoTo 0
    End With
  Set IE = Nothing
End Sub

上記のコードは 48199の内容を表示します。
(正しく、表示された場合のみ有効)
  
尚、こういうことがやりたいのなら、
DOMをよく調べることからはじめて下さい。

【48249】Re:質問をわかりやすく追加します
お礼  はる  - 07/4/10(火) 0:25 -

引用なし
パスワード
   ichinoseさん
いつも本当に有難うございます。
感動しました
ただまったく意味が分からないため
質問の仕様がありません。
なんで質問内容の部分だけ
ちゃんとメッセジで表示されるの??
その仕組みがわかりません。
きっとこれは
教えて頂いたコードの中の

MsgBox .all(76).innertext 'これは全部のエレメントを調べた結果
MsgBox .all(145).innertext

76,145 にあるのか?
サイトで調べています。
何を調べたらいいのかさえわからず・・・

よかったら教えてください。

【48252】Re:質問をわかりやすく追加します
発言  ichinose  - 07/4/10(火) 8:53 -

引用なし
パスワード
   ▼はる さん:
おはようございます。


>ただまったく意味が分からないため
>質問の仕様がありません。
Htmlの仕様とかDOMについて調べないと
体系的な理解は難しいですよ!!

>なんで質問内容の部分だけ
>ちゃんとメッセジで表示されるの??
>その仕組みがわかりません。
>きっとこれは
>教えて頂いたコードの中の
>
>MsgBox .all(76).innertext 'これは全部のエレメントを調べた結果
>MsgBox .all(145).innertext
>
>76,145 にあるのか?
これは、このサンプルサイトを調べた値であって、
すべてサイトに当てはまる数字ではないですよ!!

上記の数字は、
サイトが表示された状態で

 dim idx as long
 on error resume next
 with idoc
   for idx=0 to .all.length-1
    msgbox idx & vbcrlf & .all(idx).innertext
    next
   end with

というコードでほしいデータがあるエレメントのインデックスを
調べた結果です。

同じような事を実際のサイトで検証するのですよ!!


余談ですが、
このWebサイトが自分で作成したもの(又は、自分でコントロールできる)で
あるならば、問題ないですが(自分が作成したものなら、表示させてデータを取得
する以外にも方法がありそうですが・・)、

そうでないならば(データを読み取るサイトは別管理のサイト 今回のような質問箱サイトのようなもの)、
こういうコードを作ってしまうとメンテナンスが大変ですよ!!
だって、仕様がいつ変わってしまうかわかりませんからねえ!!

上記の数字だって、この質問箱の仕様が変われば正しく作動しない可能性は
十分考えられるのですよ!!

この点も検討して下さい。

5913 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free