ExcelのA列の単語を翻訳サイトにセット取得を自動で連続実行 (original) (raw)
2012/6/7 追記(コメント欄の動作報告を上に表示)
translation.infoseekのフォーマットが変更になったのかうまく取得できなくなっています。
objIE.Document.all("origin_doc").Value = Cells(yCNT, 1) 'A列の値を渡す
↑ここでエラーが出て止まってしまいますね。
現在、サンプルコードでは動かないみたいなので、参考程度に見てください
下記の質問を見て、昔作ったExcelからIE操作のサンプルを思い出す。
http://q.hatena.ne.jp/1279514525
【大量の英単語のリストを、日本語訳してくれるソフト】
手元に1000以上の英単語のリストがあります。この英単語を一気にすべて和訳してくれるソフト／サービスを探しています。
オリジナルな英単語帳を作りたいイメージです。
でも、無料サイトだからって、連続実行して迷惑をかけると
大量アクセス で 検索するとイロイロ出てくるけど、
岡崎市立図書館HP大量アクセス事｜ムムの呟き
http://ameblo.jp/murmur-of-ignorance/entry-10575127519.html
から、岡崎市 図書館 大量アクセスで検索
岡崎図書館事件まとめ
http://librahack.jp/
みたいなこともあるので、注意が必要だったり。。。
※無料・タダに飛びつくとタダより高い物はないにならないように。。。
※※学校の宿題も自分で紙の辞書をひいた方が勉強になったり、、まぁ今はPCの辞書や携帯電話かもしれないけど。
そんな前説はこのくらいにして(前説のほうが解説よりも長かったり)
QA0914 .Document.allを使いデータセットと結果取得を連続で
http://ken3-info.blog.ocn.ne.jp/objie/2009/09/qa0914_document.html
これを参考にして、
(※サンプルと違うのは、URLが違うのと、オプションを選択しなかっただけですが)
こんな感じかなぁ
Option Explicit
Sub ie_test_e()
Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Top = 100
objIE.Left = 100
Dim Wait_Time As Date
Dim yCNT As Integer
For yCNT = 5 To 99
If Trim(Cells(yCNT, 1)) = "" Then Exit For
objIE.Navigate "http://translation.infoseek.co.jp/?ac=Text&lng=en"
Wait_Time = DateAdd("s", 5, Now())
Do While Now() < Wait_Time
DoEvents
Loop
While objIE.ReadyState <> 4 Or objIE.Busy = True
DoEvents
Wend
objIE.Document.all("origin_doc").Value = Cells(yCNT, 1)
objIE.Document.all("submit").Click
Wait_Time = DateAdd("s", 5, Now())
Do While Now() < Wait_Time
DoEvents
Loop
While objIE.ReadyState <> 4 Or objIE.Busy = True
DoEvents
Wend
Cells(yCNT, 2) = objIE.Document.all("converted").Value
Next yCNT
objIE.Quit
Set objIE = NothingEnd Sub
実際のテストファイルは
/vba/zip/IE_TEST_0719.zip
においておくので、使ってみてください。
解説は、ほぼ同じなので、こっちに置いてある動画
QA0914 .Document.allを使いデータセットと結果取得を連続で
http://ken3-info.blog.ocn.ne.jp/objie/2009/09/qa0914_document.html
を見てください
何かの参考となれば、、、
※連続処理は注意して実行してくださいね・・・
その他 処理と関係ない広告です
下記、IE操作と関係ない広告です。
(無料サイトも 広告を狙っているのに、、、連続実行されたら悲しいなぁ・・・)なんて思いつつも、下記最近の人気商品です。
【3気圧防水 breo ブレオ シリコンウォッチ 腕時計 ロームウォッチ 7月19日...[続きを見る]
【EFX正規販売店】 EFX パフォーマンスリストバンド スポーツ WR 7月19日...[続きを見る]
【メール便送料無料】 ☆２個セット☆ SANYO 【サンヨー ＤＢ-Ｌ８ 7月19日...[続きを見る]
DS陰山メソッド 電脳反復 正しい漢字かきとりくん → 7月19日...[続きを見る]
JUNGLE STORM / サイドくしゅくしゅデザイン カーゴ ショー 7月19日...[続きを見る]
NEO by OYAIDE Elec d+ FireWire 6pin- 7月19日...[続きを見る]
SALUS アイススティックメーカー オレンジ → 7月19日...[続きを見る]
ＵＶカット99％防災フィルム50ＳＬ → 7月19日...[続きを見る]
オート 油性替芯 0.7mm （インク色：クロ) No.87NP 5セッ 7月19日...[続きを見る]
カーメイト(CARMATE) プリウス用ラウンドノブ LS138 → 7月19日...[続きを見る]
カベンディッシュ&ハーベイ コーヒードロップ 200G → 7月19日...[続きを見る]
シルバー磨きクロス 用途の違う布の2枚セット ジュエリーセーム → 7月19日...[続きを見る]
スターウォーズ ヴィンテージ ベーシック フィギュア ダース・ベイダー 7月19日...[続きを見る]
ブラック岩塩（ヒマラヤ岩塩：バスソルト） ミル 1kg → 7月19日...[続きを見る]
ブレイク ブレイド PCデスクトップアクセサリー → 7月19日...[続きを見る]
モチベーション3．0 持続する「やる気！」をいかに引き出すか - 現在人気の モチベーション3．0 持続する「やる気！」をいかに引き出すか など 本・書籍を紹介する(...[続きを見る]
ローヤル Rody ロディ コンセントキャップ → 7月19日...[続きを見る]
蛍/少年(初回限定盤)(DVD付) → 7月19日...[続きを見る]