お世話になります。
エクセルマクロでのIE操作について質問です。
環境
エクセル2007
visual basic 6.5
参照設定、デフォルトと下記二つを追加
'Microsoft Internet Controls
'Microsoft HTML object Library
エクセルでB列に入力してある単語を、http://www.langtolang.com/から、指定の言語で検索し、
検索結果をシートに貼り付けるものを作ろうとしているのですが、貼り付けに困っています。
作業手順
1、B6から下へ検索したい単語を入力する
2、C2に元の言語、D2に調べたり言語を入力(入力規則で指定しました)
ここからがマクロの手順です
3、IEを開き、指定のページへ移動
4、getelementsbytagnameで、言語の選択と、インプットボックスに単語入力
5、submit
6、検索結果が"no translation found"以外の場合、新しいシートを挿入し、シート名を検索単語に変更し、そこに検索結果をテーブルで貼り付け
7、テーブルに貼り付けたれた検索結果を、検索単語が羅列してあるシートの、検索単語の横に貼り付ける。訳が複数見つかった場合、横並びして張り付ける
これを繰り返す。
このようなものを作りたいのですが、テーブルが複数あり、また同じクラス名のテーブルも複数あるため、どうやって、検索結果だけを選択すれば良いのか困っています。
今のコードは以下です。
よろしくお願いします。
Sub open_ie()
'enable the following reference
'Microsoft Internet Controls
'Microsoft HTML object Library
'VBA version
'VBA version 6.5.10.53
Dim home As Worksheet
Set home = Sheets("Search page")
home.Activate
'open IE
Dim objIE As Object 'create variable
Set objIE = CreateObject("InternetExplorer.Application") 'create object
objIE.Visible = True 'make ie visible
objIE.Navigate "http://www.langtolang.com/" 'navigate Ie to dictionary
'wait while IE is busy
Do While objIE.Busy = True
DoEvents
Loop
'static-------------------------
'Create object variable for source and target language on IE
Dim objSourceLanguage As Object
Dim objTargetLanguage As Object
'choose language by variable.
Dim SourceLanguage As String
Dim TargetLanguage As String
SourceLanguage = Worksheets("Search page").Cells(3, 2).Value
TargetLanguage = Worksheets("Search page").Cells(5, 2).Value
'cell setting--------------------------
Dim i As Integer
i = 6
Dim word As String
'looping procedure stard from here-----------------------------
word = Cells(i, 2).Value
Do While objIE.Busy = True
DoEvents
Loop
objIE.document.forms("frmSozluk").getElementsByTagName("selectFrom") = SourceLanguage 'set source language
objIE.document.forms("frmSozluk").getElementsByTagName("selectTo") = TargetLanguage 'set target language
Do While objIE.Busy = True
DoEvents
Loop
objIE.document.forms("frmSozluk").Item("txtLang").Value = word 'set word in cells(i,2)
objIE.document.forms("frmSozluk").submit
Do While objIE.Busy = True
DoEvents
Loop
'copy output----------------------------------------
Dim table As HTMLTable
Dim sheet As Worksheet
For Each table In objIE.document.all
If table.className = "blue" Then
Sheets.Add after:=Sheets("Search page")
ActiveSheet.Name = word
Set sheet = ActiveSheet
End If
Next
home.Activate
End Sub
No.1ベストアンサー
- 回答日時:
>C2に元の言語、D2に調べたり言語
でしたら、
>SourceLanguage = Worksheets("Search page").Cells(3, 2).Value
>TargetLanguage = Worksheets("Search page").Cells(5, 2).Value
は、それぞれ、Cells(2, 3)、Cells(2, 4)、です。
コード の方が正しいと見なして、「B3に元の言語、B5に調べたい言語」として回答いたします。
>クラスが二つあり、片方をコピー
>テーブルが複数あり、また同じクラス名のテーブルも複数ある
とのことで、html ソース を見てみましたが、特に目的の <table> に「id」や「name」が付いている訳でもありませんので、このような場合は、html ソース を丸ごと読み取り、その中から、目的のものを切り出していくか、あるいは、WEB クエリ が使えるのなら、そちらをお使いになるのが簡単ではないでしょうか?
ということで、
1)html ソース を丸ごと読み取り、その中から、目的のものを切り出していく例
2)WEB クエリ を使った例
の2つを、ご参考に供します。
私の環境で試したところ、キーワード が6個の場合で、(1) は9秒、(2) は5秒掛かりました。
なお、
>参照設定、デフォルトと下記二つを追加
>'Microsoft Internet Controls
>'Microsoft HTML object Library
上記2件は必要ありません。参照設定を外してください。
また、
>6、検索結果が"no translation found"以外の場合
は考慮しておりません。
'----------------------------------
Sub use_html_source()
'Microsoft Forms 2.0 Object Libraryを参照設定
Dim home As Worksheet
Dim objIE As Object
Dim i As Integer
Dim word As String
Dim mytable As String
Dim CB As New DataObject
Set home = Sheets("Search page")
home.Activate
Set objIE = CreateObject("InternetExplorer.Application")
Application.ScreenUpdating = False
With objIE
.Navigate "http://www.langtolang.com/"
While .Busy Or .readyState <> 4: DoEvents: Wend
.document.forms("frmSozluk").Item("selectFrom").Value = home.Cells(3, 2).Value
.document.forms("frmSozluk").Item("selectTo").Value = home.Cells(5, 2).Value
For i = 6 To home.Range("B6").End(xlDown).Row
word = Cells(i, 2).Value
.document.forms("frmSozluk").Item("txtLang").Value = word
.document.forms("frmSozluk").submit
While .Busy Or .readyState <> 4: DoEvents: Wend
mytable = .document.body.innerHTML
mytable = Mid(mytable, InStr(mytable, "class=""title"""))
mytable = Mid(mytable, InStr(mytable, "class=""blue"""))
mytable = "<table><tbody><tr" & Left(mytable, InStr(mytable, "</table>")) & "/table>"
With CB
.SetText mytable
.PutInClipboard
End With
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = word
Range("A1:B1").Value = Array(home.Cells(3, 2).Value, home.Cells(5, 2).Value)
Range("A2").Select
ActiveSheet.Paste
Range(Range("B2"), Range("B" & Rows.Count).End(xlUp)).Copy
home.Select
Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Next i
End With
home.Activate
Set objIE = Nothing
Application.ScreenUpdating = True
End Sub
'----------------------------------
Sub use_web_query()
Dim home As Worksheet
Dim i As Integer
Dim word As String
Set home = Sheets("Search page")
home.Activate
Application.ScreenUpdating = False
For i = 6 To home.Range("B6").End(xlDown).Row
word = Cells(i, 2).Value
Sheets.Add after:=Sheets(Sheets.Count)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.langtolang.com/?selectFrom=" & home.Cells(3, 2).Value & _
"&selectTo=" & home.Cells(5, 2).Value & "&txtLang=" & word _
, Destination:=Range("A1"))
.WebFormatting = xlWebFormattingNone
.WebTables = "6"
.Refresh BackgroundQuery:=False
End With
ActiveSheet.Name = word
Range(Range("B2"), Range("B" & Rows.Count).End(xlUp)).Copy
home.Select
Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Next i
home.Activate
Application.ScreenUpdating = True
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Visual Basic(VBA) Excelで下記のようにマクロを作ったところ、一回目は実行できたのですが、二回目以降「実行時エラー1 1 2022/03/25 08:08
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) vba 重複データ合算 5 2023/07/05 18:55
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Excel(エクセル) フォルダ内のワードファイルをPDFに一括変換するVBA 3 2023/06/09 16:51
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 改行ごとに行を追加し、数量を分割 4 2023/07/11 16:39
- Visual Basic(VBA) VBA 別ブックからの転記の高速化について VBA 別ブックからの転記の高速化についてご教授下さい。 19 2022/07/26 13:07
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
C言語、C+、C++、C#の違い
-
Pythonって何を意識した言語な...
-
COBOLで文字タイプを数字...
-
プログラムに書かれる"%"記号の...
-
TO_CHARで小数点以下がある場合...
-
C++ ってなんて読む?
-
UNITY Float型の接尾辞fって
-
C言語とhtmlの違いを どな...
-
COBOLでのNOT = の AND条件
-
VBSとWSHは読み方が違うだけで...
-
HTMLてインタプリタの類になる?
-
Int('1234') で、strをかんたん...
-
Solve()とは、なんですか?
-
質問失礼します。 プログラム言...
-
プログラミング言語の制作方法...
-
PL/Iソースからのコメント部分削除
-
HTMLとC++で、どんなホームペー...
-
「VB」と「VB.NET」の違いについて
-
MPLAB C18のC言語について
-
アプリ開発について 初心者です...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
C言語、C+、C++、C#の違い
-
質問失礼します。 プログラム言...
-
最新のプログラム言語を学ぶに...
-
COBOLでのNOT = の AND条件
-
C言語って古いですか?
-
rpa化する言語としてら何があり...
-
UNITY Float型の接尾辞fって
-
TO_CHARで小数点以下がある場合...
-
プログラミング言語の制作方法...
-
COBOLで文字タイプを数字...
-
プログラムに書かれる"%"記号の...
-
C言語とhtmlの違いを どな...
-
Int('1234') で、strをかんたん...
-
C++ ってなんて読む?
-
Excel VBAで文字化けする (英語...
-
C言語 解答について。
-
VBSでDim、Private、Publicの違い
-
Excelの開発言語ってなんですか?
-
C# でソフト開発をした事のある...
-
C#とC++のざっくりとした違いを...
おすすめ情報